home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / hhvbcls / clshtmlh.cls next >
Text File  |  1999-08-25  |  83KB  |  2,920 lines

  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "HTMLHelp"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = True
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = False
  10. ' ********************************************************
  11. ' HTML Help class module version 3.0d
  12. ' (c)September 1999, Delmar Computing Services
  13. '
  14. ' For use with Microsoft Visual Basic(r)
  15. ' versions 4 (32-bit), 5 and 6
  16. '
  17. ' Developed by David Liske, Tipton, Michigan, USA
  18. ' Microsoft HTML Help MVP 1999
  19. ' http://www.vbexplorer.com/htmlhelp.asp
  20. '
  21. ' Please send any performance or functionality
  22. ' modifications of this file to delmar@tc3net.com
  23. ' ________________________________________________________
  24. '
  25. ' Proof-of-concept testing and some HTML Help
  26. ' API research provided by Robert Chandler,
  27. ' The HelpWare Group, and Varian Corporation,
  28. ' Melbourne, Vic, Australia
  29. ' Microsoft HTML Help MVP 1999
  30. ' http://www.helpware.net
  31. '
  32. ' Some registry functionality re-developed from
  33. ' original code written by Dave Scarmozzino
  34. ' http://www.TheScarms.com
  35. '
  36. ' Beta testing (July 1999):
  37. ' Lani Hardage, MDL Information Systems, Inc.
  38. ' Steve Hsu, TREEV, Inc.
  39. ' John Hunt, Lotus Development Corporation
  40. ' Shirley Kelly, Corbel, A SunGard Company
  41. ' Valerie A. Lipow, Compuware Corporation
  42. ' Leyden Martinez, Copextel, S.A., Cuba
  43. ' Alejandro Sicilia, Copextel, S.A., Cuba
  44. '
  45. ' Further testing by Dana Cline,
  46. ' Lucent Technologies, Boulder, Colorado
  47. ' Microsoft HTML Help MVP 1998, 1999
  48. '
  49. ' Modifications of HTML Help version-checking and
  50. ' IE version-checking code, and Windows NT/2000
  51. ' problem-solving,
  52. ' by Leonardo Presciuttini, Italy (August 1999)
  53. '
  54. ' GetLongPath_Legacy logic checks and code modifications,
  55. ' and all-around support of a programming geek's
  56. ' chocolate and strange snacking needs, by:
  57. ' Marnella Liske, RN, BSN
  58. ' University of Michigan Medical Center
  59. '
  60. ' ********************************************************
  61.  
  62. Option Explicit
  63. Option Compare Text
  64.  
  65. ' Public declarations
  66. Public frm As Object
  67. Public hwnd As Long
  68. Public lpPrevWndFunc As Long
  69.  
  70. Public Enum PopupType
  71.   HH_CHM_POPUP = &H1
  72.   HH_RESOURCE_POPUP = &H2
  73.   HH_TEXT_POPUP = &H4
  74. End Enum
  75.  
  76. Public Enum HHVersion
  77.   HH_1_0 = &H10
  78.   HH_1_1 = &H11
  79.   HH_1_1A = &H12
  80.   HH_1_1B = &H13
  81.   HH_1_2 = &H14
  82.   HH_1_21 = &H15
  83.   HH_1_21A = &H16
  84.   HH_1_22 = &H17
  85.   HH_1_3 = &H18
  86. End Enum
  87.  
  88. Public Enum IEVersion
  89.   IE_3_0 = &H100
  90.   IE_3_0_OSR2 = &H101
  91.   IE_3_01 = &H102
  92.   IE_3_02 = &H103
  93.   IE_4_0_PP2 = &H104
  94.   IE_4_0 = &H105
  95.   IE_4_01 = &H106
  96.   IE_4_01_SP1 = &H107
  97.   IE_4_01_SP2 = &H108
  98.   IE_5_0_Beta1 = &H109
  99.   IE_5_0_Beta2 = &H10A
  100.   IE_5_0 = &H10B
  101.   IE_5_0A = &H10C
  102.   IE_5_0B = &H10D
  103.   IE_5_0C = &H10E
  104. End Enum
  105.  
  106. ' HTML Help Version Constants
  107. Private Const extHH_1_0 = "4.72.7290"
  108. Private Const extHH_1_1 = "4.72.7323"
  109. Private Const extHH_1_1A = "4.72.7325"
  110. Private Const extHH_1_1B = "4.72.8164.0"
  111. Private Const extHH_1_2 = "4.73.8252"
  112. Private Const extHH_1_21 = "4.73.8412"
  113. Private Const extHH_1_21A = "4.73.8474"
  114. Private Const extHH_1_22 = "4.73.8561"
  115. Private Const extHH_1_3 = "4.74.8566"
  116.  
  117. ' Internet Explorer Version Constants
  118. Private Const extIE_3_0 = "4.70.1155"
  119. Private Const extIE_3_0_OSR2 = "4.70.1158"
  120. Private Const extIE_3_01 = "4.70.1215"
  121. Private Const extIE_3_02 = "4.70.1300"
  122. Private Const extIE_4_0_PP2 = "4.71.1008.3"
  123. Private Const extIE_4_0 = "4.71.1712.5"
  124. Private Const extIE_4_01 = "4.72.2106.7"
  125. Private Const extIE_4_01_SP1 = "4.72.3110.03"
  126. Private Const extIE_4_01_SP2 = "4.72.3612.1707"
  127. Private Const extIE_5_0_Beta1 = "5.00.0518.5"
  128. Private Const extIE_5_0_Beta2 = "5.00.0910.1308"
  129. Private Const extIE_5_0 = "5.00.2014.213"
  130. Private Const extIE_5_0A = "5.00.2314.1000"
  131. Private Const extIE_5_0B = "5.00.2614.3500"
  132. Private Const extIE_5_0C = "5.0.2717.2000"
  133.  
  134. Private Const extUNKNOWN = "unknown"
  135.  
  136. ' HTML Help Constants
  137. Private Const HH_DISPLAY_TOPIC = &H0            '  WinHelp equivalent
  138. Private Const HH_DISPLAY_TOC = &H1              '  WinHelp equivalent
  139. Private Const HH_DISPLAY_INDEX = &H2            '  WinHelp equivalent
  140. Private Const HH_DISPLAY_SEARCH = &H3           '  WinHelp equivalent
  141. Private Const HH_SET_WIN_TYPE = &H4
  142. Private Const HH_GET_WIN_TYPE = &H5
  143. Private Const HH_GET_WIN_HANDLE = &H6
  144. Private Const HH_SYNC = &H9
  145. Private Const HH_ADD_NAV_UI = &HA               ' not currently implemented
  146. Private Const HH_ADD_BUTTON = &HB               ' not currently implemented
  147. Private Const HH_GETBROWSER_APP = &HC           ' not currently implemented
  148. Private Const HH_KEYWORD_LOOKUP = &HD           '  WinHelp equivalent
  149. Private Const HH_DISPLAY_TEXT_POPUP = &HE       ' display string resource id
  150.                                                 ' or text in a popup window
  151.                                                 ' value in dwData
  152. Private Const HH_HELP_CONTEXT = &HF             '  display mapped numeric
  153. Private Const HH_CLOSE_ALL = &H12               '  WinHelp equivalent
  154. Private Const HH_ALINK_LOOKUP = &H13            '  ALink version of
  155.                                                 '  HH_KEYWORD_LOOKUP
  156. Private Const HH_SET_GUID = &H1A                ' For Microsoft Installer -- dwData is a pointer to the GUID string
  157.  
  158. ' HTML Help window constants. These are also used
  159. ' in the window definitions in HHP files
  160. Private Const HHWIN_PROP_ONTOP = &H2              ' Top-most window (not currently implemented)
  161. Private Const HHWIN_PROP_NOTITLEBAR = &H4         ' no title bar
  162. Private Const HHWIN_PROP_NODEF_STYLES = &H8       ' no default window styles (only HH_WINTYPE.dwStyles)
  163. Private Const HHWIN_PROP_NODEF_EXSTYLES = &H10    ' no default extended window styles (only HH_WINTYPE.dwExStyles)
  164. Private Const HHWIN_PROP_TRI_PANE = &H20          ' use a tri-pane window
  165. Private Const HHWIN_PROP_NOTB_TEXT = &H40         ' no text on toolbar buttons
  166. Private Const HHWIN_PROP_POST_QUIT = &H80         ' post WM_QUIT message when window closes
  167. Private Const HHWIN_PROP_AUTO_SYNC = &H100        ' automatically ssync contents and index
  168. Private Const HHWIN_PROP_TRACKING = &H200         ' send tracking notification messages
  169. Private Const HHWIN_PROP_TAB_SEARCH = &H400       ' include search tab in navigation pane
  170. Private Const HHWIN_PROP_TAB_HISTORY = &H800      ' include history tab in navigation pane
  171. Private Const HHWIN_PROP_TAB_BOOKMARKS = &H1000   ' include bookmark tab in navigation pane
  172. Private Const HHWIN_PROP_CHANGE_TITLE = &H2000    ' Put current HTML title in title bar
  173. Private Const HHWIN_PROP_NAV_ONLY_WIN = &H4000    ' Only display the navigation window
  174. Private Const HHWIN_PROP_NO_TOOLBAR = &H8000      ' Don't display a toolbar
  175. Private Const HHWIN_PROP_MENU = &H10000           ' Menu
  176. Private Const HHWIN_PROP_TAB_ADVSEARCH = &H20000  ' Advanced FTS UI.
  177. Private Const HHWIN_PROP_USER_POS = &H40000       ' After initial creation, user controls window size/position
  178.  
  179. Private Const HHWIN_PARAM_PROPERTIES = &H2        ' valid fsWinProperties
  180. Private Const HHWIN_PARAM_STYLES = &H4            ' valid dwStyles
  181. Private Const HHWIN_PARAM_EXSTYLES = &H8          ' valid dwExStyles
  182. Private Const HHWIN_PARAM_RECT = &H10             ' valid rcWindowPos
  183. Private Const HHWIN_PARAM_NAV_WIDTH = &H20        ' valid iNavWidth
  184. Private Const HHWIN_PARAM_SHOWSTATE = &H40        ' valid nShowState
  185. Private Const HHWIN_PARAM_INFOTYPES = &H80        ' valid apInfoTypes
  186. Private Const HHWIN_PARAM_TB_FLAGS = &H100        ' valid fsToolBarFlags
  187. Private Const HHWIN_PARAM_EXPANSION = &H200       ' valid fNotExpanded
  188. Private Const HHWIN_PARAM_TABPOS = &H400          ' valid tabpos
  189. Private Const HHWIN_PARAM_TABORDER = &H800        ' valid taborder
  190. Private Const HHWIN_PARAM_HISTORY_COUNT = &H1000  ' valid cHistory
  191. Private Const HHWIN_PARAM_CUR_TAB = &H2000        ' valid curNavType
  192.  
  193. Private Const HHWIN_BUTTON_EXPAND = &H2           ' Expand/contract button
  194. Private Const HHWIN_BUTTON_BACK = &H4             ' Back button
  195. Private Const HHWIN_BUTTON_FORWARD = &H8          ' Forward button
  196. Private Const HHWIN_BUTTON_STOP = &H10            ' Stop button
  197. Private Const HHWIN_BUTTON_REFRESH = &H20         ' Refresh button
  198. Private Const HHWIN_BUTTON_HOME = &H40            ' Home button
  199. Private Const HHWIN_BUTTON_BROWSE_FWD = &H80      ' not implemented
  200. Private Const HHWIN_BUTTON_BROWSE_BCK = &H100     ' not implemented
  201. Private Const HHWIN_BUTTON_NOTES = &H200          ' not implemented
  202. Private Const HHWIN_BUTTON_CONTENTS = &H400       ' not implemented
  203. Private Const HHWIN_BUTTON_SYNC = &H800           ' Locate button
  204. Private Const HHWIN_BUTTON_OPTIONS = &H1000       ' Options button
  205. Private Const HHWIN_BUTTON_PRINT = &H2000         ' Print button
  206. Private Const HHWIN_BUTTON_INDEX = &H4000         ' not implemented
  207. Private Const HHWIN_BUTTON_SEARCH = &H8000        ' not implemented
  208. Private Const HHWIN_BUTTON_HISTORY = &H10000      ' not implemented
  209. Private Const HHWIN_BUTTON_BOOKMARKS = &H20000    ' not implemented
  210. Private Const HHWIN_BUTTON_JUMP1 = &H40000        ' Jump1 button
  211. Private Const HHWIN_BUTTON_JUMP2 = &H80000        ' Jump2 button
  212. Private Const HHWIN_BUTTON_ZOOM = &H100000        ' Font sizing button
  213. Private Const HHWIN_BUTTON_TOC_NEXT = &H200000    ' Browse next TOC topic button
  214. Private Const HHWIN_BUTTON_TOC_PREV = &H400000    ' Browse previous TOC topic button
  215.  
  216. ' Default button set
  217. Private Const HHWIN_DEF_BUTTONS = _
  218.             (HHWIN_BUTTON_EXPAND Or _
  219.              HHWIN_BUTTON_BACK Or _
  220.              HHWIN_BUTTON_OPTIONS Or _
  221.              HHWIN_BUTTON_PRINT)
  222.  
  223. ' Button IDs
  224. Private Const IDTB_EXPAND = 200
  225. Private Const IDTB_CONTRACT = 201
  226. Private Const IDTB_STOP = 202
  227. Private Const IDTB_REFRESH = 203
  228. Private Const IDTB_BACK = 204
  229. Private Const IDTB_HOME = 205
  230. Private Const IDTB_SYNC = 206
  231. Private Const IDTB_PRINT = 207
  232. Private Const IDTB_OPTIONS = 208
  233. Private Const IDTB_FORWARD = 209
  234. Private Const IDTB_NOTES = 210             ' not implemented
  235. Private Const IDTB_BROWSE_FWD = 211
  236. Private Const IDTB_BROWSE_BACK = 212
  237. Private Const IDTB_CONTENTS = 213          ' not implemented
  238. Private Const IDTB_INDEX = 214             ' not implemented
  239. Private Const IDTB_SEARCH = 215            ' not implemented
  240. Private Const IDTB_HISTORY = 216           ' not implemented
  241. Private Const IDTB_BOOKMARKS = 217         ' not implemented
  242. Private Const IDTB_JUMP1 = 218
  243. Private Const IDTB_JUMP2 = 219
  244. Private Const IDTB_CUSTOMIZE = 221
  245. Private Const IDTB_ZOOM = 222
  246. Private Const IDTB_TOC_NEXT = 223
  247. Private Const IDTB_TOC_PREV = 224
  248.  
  249. Private Enum HHACT_
  250.   HHACT_TAB_CONTENTS
  251.   HHACT_TAB_INDEX
  252.   HHACT_TAB_SEARCH
  253.   HHACT_TAB_HISTORY
  254.   HHACT_TAB_FAVORITES
  255.     
  256.   HHACT_EXPAND
  257.   HHACT_CONTRACT
  258.   HHACT_BACK
  259.   HHACT_FORWARD
  260.   HHACT_STOP
  261.   HHACT_REFRESH
  262.   HHACT_HOME
  263.   HHACT_SYNC
  264.   HHACT_OPTIONS
  265.   HHACT_PRINT
  266.   HHACT_HIGHLIGHT
  267.   HHACT_CUSTOMIZE
  268.   HHACT_JUMP1
  269.   HHACT_JUMP2
  270.   HHACT_ZOOM
  271.   HHACT_TOC_NEXT
  272.   HHACT_TOC_PREV
  273.   HHACT_NOTES
  274.  
  275.   HHACT_LAST_ENUM
  276. End Enum
  277.  
  278. Private Enum HHWIN_NAVTYPE_
  279.   HHWIN_NAVTYPE_TOC
  280.   HHWIN_NAVTYPE_INDEX
  281.   HHWIN_NAVTYPE_SEARCH
  282.   HHWIN_NAVTYPE_HISTORY       ' not implemented
  283.   HHWIN_NAVTYPE_FAVORITES     ' not implemented
  284. End Enum
  285.  
  286. Enum HHWIN_NAVTAB_
  287.   HHWIN_NAVTAB_TOP
  288.   HHWIN_NAVTAB_LEFT
  289.   HHWIN_NAVTAB_BOTTOM
  290. End Enum
  291.  
  292. Private Const HH_MAX_TABS = 19               ' maximum number of tabs
  293.  
  294. Private Enum HH_TAB_
  295.   HH_TAB_CONTENTS
  296.   HH_TAB_INDEX
  297.   HH_TAB_SEARCH
  298.   HH_TAB_HISTORY
  299.   HH_TAB_FAVORITES
  300. End Enum
  301.  
  302. Private Type RECT
  303.   Left As Long
  304.   Top As Long
  305.   Right As Long
  306.   Bottom As Long
  307. End Type
  308.  
  309. Private Type tagHH_WINTYPE
  310.   cbStruct As Long            ' IN: size of this structure including all Information Types
  311.   fUniCodeStrings As Long     ' IN/OUT: TRUE if all strings are in UNICODE
  312.   pszType  As String          ' IN/OUT: Name of a type of window
  313.   fsValidMembers As Long      ' IN: Bit flag of valid members (HHWIN_PARAM_)
  314.   fsWinProperties As Long     ' IN/OUT: Properties/attributes of the window (HHWIN_)
  315.   pszCaption As String        ' IN/OUT: Window title
  316.   dwStyles  As Long           ' IN/OUT: Window styles
  317.   dwExStyles As Long          ' IN/OUT: Extended Window styles
  318.   rcWindowPos As RECT         ' IN: Starting position, OUT: current position
  319.   nShowState As Long          ' IN: show state (e.g., SW_SHOW)
  320.   hwndHelp As Long            ' OUT: window handle
  321.   hwndCaller As Long          ' OUT: who called this window
  322.   paInfoTypes As Long         ' IN: Pointer to an array of Information Types
  323.  
  324.   ' The following members are only valid if HHWIN_PROP_TRI_PANE is set
  325.  
  326.   hwndToolBar As Long         ' OUT: toolbar window in tri-pane window
  327.   hwndNavigation As Long      ' OUT: navigation window in tri-pane window
  328.   hwndHTML As Long            ' OUT: window displaying HTML in tri-pane window
  329.   iNavWidth As Long           ' IN/OUT: width of navigation window
  330.   rcHTML As RECT              ' OUT: HTML window coordinates
  331.  
  332.   pszToc As String            ' IN: Location of the table of contents file
  333.   pszIndex As String          ' IN: Location of the index file
  334.   pszFile As String           ' IN: Default location of the html file
  335.   pszHome As String           ' IN/OUT: html file to display when Home button is clicked
  336.   fsToolBarFlags As Long      ' IN: flags controling the appearance of the toolbar
  337.   fNotExpanded As Long        ' IN: TRUE/FALSE to contract or expand, OUT: current state
  338.   curNavType As Long          ' IN/OUT: UI to display in the navigational pane
  339.   tabpos As HHWIN_NAVTAB_     ' IN/OUT: HHWIN_NAVTAB_TOP, HHWIN_NAVTAB_LEFT, or HHWIN_NAVTAB_BOTTOM
  340.   idNotify As Long            ' IN: ID to use for WM_NOTIFY messages
  341.   tabOrder(HH_MAX_TABS) As Byte ' IN/OUT: tab order: Contents, Index, Search, History, Favorites, Reserved 1-5, Custom tabs
  342.   cHistory As Long            ' IN/OUT: number of history items to keep (default is 30)
  343.   pszJump1 As String          ' Text for HHWIN_BUTTON_JUMP1
  344.   pszJump2 As String          ' Text for HHWIN_BUTTON_JUMP2
  345.   pszUrlJump1 As String       ' URL for HHWIN_BUTTON_JUMP1
  346.   pszUrlJump2 As String       ' URL for HHWIN_BUTTON_JUMP2
  347.   rcMinSize As RECT           ' Minimum size for window (ignored in version 1)
  348.   cbInfoTypes As Long         ' size of paInfoTypes;
  349. End Type
  350.  
  351. ' UDT for mouse cursor position
  352. Private Type POINTAPI
  353.   x As Long
  354.   y As Long
  355. End Type
  356.  
  357. ' UDT for text popups
  358. Private Type tagHH_POPUP
  359.   cbStruct As Integer                         ' sizeof this structure
  360.   hinst As Long                               ' instance handle for string resource
  361.   idString As Long                            ' string resource id, or text id if pszFile
  362.                                               ' is specified in HtmlHelp call
  363.   pszText As String                           ' used if idString is zero
  364.   pt As POINTAPI                              ' top center of popup window
  365.   clrForeground As ColorConstants             ' either use VB constant or &HBBGGRR
  366.   clrBackground As ColorConstants             ' either use VB constant or &HBBGGRR
  367.   rcMargins As RECT                           ' amount of space between edges of window and
  368.                                               ' text, -1 for each member to ignore
  369.   pszFont As String                           ' facename, point size, char set, BOLD ITALIC
  370.                                               ' UNDERLINE
  371. End Type
  372.  
  373. ' UDT for keyword and ALink searches
  374. Private Type tagHH_AKLINK
  375.   cbStruct          As Long
  376.   fReserved         As Boolean
  377.   pszKeywords       As String
  378.   pszUrl            As String
  379.   pszMsgText        As String
  380.   pszMsgTitle       As String
  381.   pszWindow         As String
  382.   fIndexOnFail      As Boolean
  383. End Type
  384.  
  385. ' UDT for accessing the Search tab
  386. Private Type tagHH_FTS_QUERY
  387.   cbStruct          As Long
  388.   fUniCodeStrings   As Long
  389.   pszSearchQuery    As String
  390.   iProximity        As Long
  391.   fStemmedSearch    As Long
  392.   fTitleOnly        As Long
  393.   fExecute          As Long
  394.   pszWindow         As String
  395. End Type
  396.  
  397. ' Constants for converting the cursor to What's This Help
  398. Private Const WM_SYSCOMMAND = &H112
  399. Private Const SC_CONTEXTHELP = &HF180&
  400.                                                
  401. ' Message Box Constants
  402. Private Const MB_ABORTRETRYIGNORE = &H2&
  403. Private Const MB_APPLMODAL = &H0&
  404. Private Const MB_COMPOSITE = &H2
  405. Private Const MB_DEFAULT_DESKTOP_ONLY = &H20000
  406. Private Const MB_DEFBUTTON1 = &H0&
  407. Private Const MB_DEFBUTTON2 = &H100&
  408. Private Const MB_DEFBUTTON3 = &H200&
  409. Private Const MB_DEFMASK = &HF00&
  410. Private Const MB_ICONASTERISK = &H40&
  411. Private Const MB_ICONEXCLAMATION = &H30&
  412. Private Const MB_ICONHAND = &H10&
  413. Private Const MB_ICONINFORMATION = MB_ICONASTERISK
  414. Private Const MB_ICONMASK = &HF0&
  415. Private Const MB_ICONQUESTION = &H20&
  416. Private Const MB_ICONSTOP = MB_ICONHAND
  417. Private Const MB_MISCMASK = &HC000&
  418. Private Const MB_MODEMASK = &H3000&
  419. Private Const MB_NOFOCUS = &H8000&
  420. Private Const MB_OK = &H0&
  421. Private Const MB_OKCANCEL = &H1&
  422. Private Const MB_PRECOMPOSED = &H1
  423. Private Const MB_RETRYCANCEL = &H5&
  424. Private Const MB_SETFOREGROUND = &H10000
  425. Private Const MB_SYSTEMMODAL = &H1000&
  426. Private Const MB_TASKMODAL = &H2000&
  427. Private Const MB_TYPEMASK = &HF&
  428. Private Const MB_USEGLYPHCHARS = &H4
  429. Private Const MB_YESNO = &H4&
  430. Private Const MB_YESNOCANCEL = &H3&
  431.  
  432. ' Registry API call Constants
  433. Private Const HKEY_LOCAL_MACHINE = &H80000002
  434. Private Const ERROR_SUCCESS = 0&
  435. Private Const STANDARD_RIGHTS_ALL = &H1F0000
  436. Private Const KEY_QUERY_VALUE = &H1
  437. Private Const KEY_SET_VALUE = &H2
  438. Private Const KEY_CREATE_SUB_KEY = &H4
  439. Private Const KEY_ENUMERATE_SUB_KEYS = &H8
  440. Private Const KEY_NOTIFY = &H10
  441. Private Const KEY_CREATE_LINK = &H20
  442. Private Const SYNCHRONIZE = &H100000
  443. Private Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))
  444.  
  445. Private Const MAX_PATH = 260
  446. Private Const INVALID_HANDLE_VALUE = -1
  447.  
  448. ' RegCreateKeyEx options
  449. Private Const REG_OPTION_NON_VOLATILE = 0
  450.  
  451. ' Registry data types
  452. Private Const REG_NONE = 0
  453. Private Const REG_SZ = 1
  454. Private Const REG_EXPAND_SZ = 2
  455. Private Const REG_BINARY = 3
  456. Private Const REG_DWORD = 4
  457.  
  458. ' FindFirstFile return values
  459. Private Const ERROR_FILE_NOT_FOUND = 2&
  460. Private Const ERROR_MORE_DATA = 234
  461. Private Const ERROR_NO_MORE_ITEMS = 259&
  462.  
  463. ' Constants for Registry top-level keys
  464. Private Const HKEY_CURRENT_USER = &H80000001
  465. Private Const HKEY_USERS = &H80000003
  466. Private Const HKEY_DYN_DATA = &H80000006
  467. Private Const HKEY_CURRENT_CONFIG = &H80000005
  468. Private Const HKEY_CLASSES_ROOT = &H80000000
  469.  
  470. Private Const MAX_SIZE = 2048
  471. Private Const MAX_INISIZE = 8192
  472.  
  473. Private Const GWL_STYLE = (-16)
  474. Private Const GWL_EXSTYLE = (-20)
  475. Private Const GWL_WNDPROC = (-4)
  476.  
  477. ' Constants for GetLongPath_Legacy
  478. Private Const SINGLE_QUOTE = """"
  479.  
  480. ' Constants for determining OS
  481. Private Const VER_PLATFORM_WIN32s = 0
  482. Private Const VER_PLATFORM_WIN32_WINDOWS = 1
  483. Private Const VER_PLATFORM_WIN32_NT = 2
  484.  
  485. Private Const UNKNOWN_OS = 0
  486. Private Const WINDOWS_NT_3_51 = 1
  487. Private Const WINDOWS_95 = 2
  488. Private Const WINDOWS_NT_4 = 3
  489. Private Const WINDOWS_98 = 4
  490. Private Const WINDOWS_2000 = 5
  491.  
  492. ' UDT for determining OS
  493. Private Type OSVERSIONINFO
  494.   dwOSVersionInfoSize As Long
  495.   dwMajorVersion As Long
  496.   dwMinorVersion As Long
  497.   dwBuildNumber As Long
  498.   dwPlatformId As Long
  499.   szCSDVersion As String * 128
  500. End Type
  501.  
  502. ' UDT for message box API calls
  503. Private Type MSGBOXPARAMS
  504.   cbSize As Long
  505.   hWndOwner As Long
  506.   hInstance As Long
  507.   lpszText As String
  508.   lpszCaption As String
  509.   dwStyle As Long
  510.   lpszIcon As String
  511.   dwContextHelpId As Long
  512.   lpfnMsgBoxCallback As Long
  513.   dwLanguageId As Long
  514. End Type
  515.  
  516. ' Registry UDT's
  517. Private Type SECURITY_ATTRIBUTES
  518.   nLength As Long
  519.   lpSecurityDescriptor As Long
  520.   bInheritHandle As Long
  521. End Type
  522.  
  523. Private Type HH_REG_VALUES
  524.   pszFileName     As String
  525.   pszFilePath     As String
  526. End Type
  527.  
  528. Private Type FILETIME
  529.   dwLowDateTime As Long
  530.   dwHighDateTime As Long
  531. End Type
  532.  
  533. Private Type WIN32_FIND_DATA
  534.   dwFileAttributes As Long
  535.   ftCreationTime As FILETIME
  536.   ftLastAccessTime As FILETIME
  537.   ftLastWriteTime As FILETIME
  538.   nFileSizeHigh As Long
  539.   nFileSizeLow As Long
  540.   dwReserved0 As Long
  541.   dwReserved1 As Long
  542.   cFileName As String * MAX_PATH
  543.   cAlternate As String * 14
  544. End Type
  545.  
  546. Private Type VS_FIXEDFILEINFO
  547.   dwSignature As Long
  548.   dwStrucVersionl As Integer     '  e.g. = &h0000 = 0
  549.   dwStrucVersionh As Integer     '  e.g. = &h0042 = .42
  550.   dwFileVersionMSl As Integer    '  e.g. = &h0003 = 3
  551.   dwFileVersionMSh As Integer    '  e.g. = &h0075 = .75
  552.   dwFileVersionLSl As Integer    '  e.g. = &h0000 = 0
  553.   dwFileVersionLSh As Integer    '  e.g. = &h0031 = .31
  554.   dwProductVersionMSl As Integer '  e.g. = &h0003 = 3
  555.   dwProductVersionMSh As Integer '  e.g. = &h0010 = .1
  556.   dwProductVersionLSl As Integer '  e.g. = &h0000 = 0
  557.   dwProductVersionLSh As Integer '  e.g. = &h0031 = .31
  558.   dwFileFlagsMask As Long        '  = &h3F for version "0.42"
  559.   dwFileFlags As Long            '  e.g. VFF_DEBUG Or VFF_PRERELEASE
  560.   dwFileOS As Long               '  e.g. VOS_DOS_WINDOWS16
  561.   dwFileType As Long             '  e.g. VFT_DRIVER
  562.   dwFileSubtype As Long          '  e.g. VFT2_DRV_KEYBOARD
  563.   dwFileDateMS As Long           '  e.g. 0
  564.   dwFileDateLS As Long           '  e.g. 0
  565. End Type
  566.  
  567. ' HTML Help API declarations
  568. Private Declare Function HTMLHelp Lib "hhctrl.ocx" _
  569.     Alias "HtmlHelpA" (ByVal hwnd As Long, _
  570.     ByVal lpHelpFile As String, _
  571.     ByVal wCommand As Long, _
  572.     ByVal dwData As Long) As Long
  573.     
  574. Private Declare Function HTMLHelpCallSearch Lib "hhctrl.ocx" _
  575.     Alias "HtmlHelpA" (ByVal hwnd As Long, _
  576.     ByVal lpHelpFile As String, _
  577.     ByVal wCommand As Long, _
  578.     ByRef dwData As tagHH_FTS_QUERY) As Long
  579.     
  580. Private Declare Function HTMLHelpKeyWord Lib "hhctrl.ocx" _
  581.     Alias "HtmlHelpA" (ByVal hwnd As Long, _
  582.     ByVal lpHelpFile As String, _
  583.     ByVal wCommand As Long, _
  584.     dwData As tagHH_AKLINK) As Long
  585.     
  586. Private Declare Function htmlHelpTextPopup Lib "hhctrl.ocx" _
  587.     Alias "HtmlHelpA" (ByVal hwnd As Long, _
  588.     ByVal lpHelpFile As String, _
  589.     ByVal wCommand As Long, _
  590.     ByRef dwData As tagHH_POPUP) As Long
  591.     
  592. Private Declare Function htmlHelpTopic Lib "hhctrl.ocx" _
  593.     Alias "HtmlHelpA" (ByVal hwnd As Long, _
  594.     ByVal lpHelpFile As String, _
  595.     ByVal wCommand As Long, _
  596.     ByVal dwData As String) As Long
  597.     
  598. ' Subclassing API declarations
  599. Private Declare Function DefWindowProc Lib "user32" _
  600.     Alias "DefWindowProcA" (ByVal hwnd As Long, _
  601.     ByVal wMsg As Long, _
  602.     ByVal wParam As Long, _
  603.     ByVal lParam As Long) As Long
  604.  
  605. ' Registry API declarations
  606. Private Declare Function RegCreateKeyEx Lib "advapi32.dll" _
  607.     Alias "RegCreateKeyExA" (ByVal hKey As Long, _
  608.     ByVal lpSubKey As String, _
  609.     ByVal Reserved As Long, _
  610.     ByVal lpClass As String, _
  611.     ByVal dwOptions As Long, _
  612.     ByVal samDesired As Long, _
  613.     lpSecurityAttributes As SECURITY_ATTRIBUTES, _
  614.     phkResult As Long, _
  615.     lpdwDisposition As Long) As Long
  616.     
  617. Private Declare Function ExpandEnvironmentStrings _
  618.     Lib "kernel32" Alias "ExpandEnvironmentStringsA" _
  619.     (ByVal lpSrc As String, _
  620.     ByVal lpDst As String, _
  621.     ByVal nSize As Long) As Long
  622.         
  623. Private Declare Function RegCloseKey Lib "advapi32.dll" _
  624.     (ByVal hKey As Long) As Long
  625.         
  626. Private Declare Function RegDeleteValue Lib "advapi32.dll" _
  627.     Alias "RegDeleteValueA" _
  628.     (ByVal hKey As Long, _
  629.     ByVal lpValueName As String) As Long
  630.  
  631. Private Declare Function RegEnumKey Lib "advapi32.dll" _
  632.     Alias "RegEnumKeyA" _
  633.     (ByVal hKey As Long, _
  634.     ByVal dwIndex As Long, _
  635.     ByVal lpName As String, _
  636.     ByVal cbName As Long) As Long
  637.  
  638. Private Declare Function RegEnumValue Lib "advapi32.dll" _
  639.     Alias "RegEnumValueA" _
  640.     (ByVal hKey As Long, _
  641.     ByVal dwIndex As Long, _
  642.     ByVal lpValueName As String, _
  643.     lpcbValueName As Long, _
  644.     ByVal lpReserved As Long, _
  645.     lpType As Long, _
  646.     lpData As Any, _
  647.     lpcbData As Long) As Long
  648.     
  649. Private Declare Function RegOpenKeyEx Lib "advapi32.dll" _
  650.     Alias "RegOpenKeyExA" (ByVal hKey As Long, _
  651.     ByVal lpSubKey As String, _
  652.     ByVal ulOptions As Long, _
  653.     ByVal samDesired As Long, _
  654.     phkResult As Long) As Long
  655.  
  656. Private Declare Function RegQueryValue Lib "advapi32.dll" _
  657.     Alias "RegQueryValueA" _
  658.     (ByVal hKey As Long, _
  659.     ByVal lpSubKey As String, _
  660.     ByVal lpValue As String, _
  661.     lpcbValue As Long) As Long
  662.  
  663. Private Declare Function RegQueryValueEx Lib "advapi32.dll" _
  664.     Alias "RegQueryValueExA" (ByVal hKey As Long, _
  665.     ByVal lpValueName As String, _
  666.     ByVal lpReserved As Long, _
  667.     lpType As Long, lpData As Any, _
  668.     lpcbData As Long) As Long
  669.  
  670. Private Declare Function RegSetValueEx Lib "advapi32.dll" _
  671.     Alias "RegSetValueExA" _
  672.     (ByVal hKey As Long, _
  673.     ByVal lpValueName As String, _
  674.     ByVal Reserved As Long, _
  675.     ByVal dwType As Long, _
  676.     lpData As Any, _
  677.     ByVal cbData As Long) As Long
  678.  
  679. ' Calls to find actual file
  680. Private Declare Function FindClose Lib "kernel32" _
  681.     (ByVal hFindFile As Long) As Long
  682.     
  683. Private Declare Function FindFirstFile Lib "kernel32" _
  684.     Alias "FindFirstFileA" (ByVal lpFileName As String, _
  685.     lpFindFileData As WIN32_FIND_DATA) As Long
  686.  
  687. ' Declarations to retrieve version information
  688. Private Declare Function GetFileVersionInfo& _
  689.     Lib "version.dll" Alias "GetFileVersionInfoA" _
  690.     (ByVal lptstrFilename As String, _
  691.     ByVal dwHandle As Long, _
  692.     ByVal dwLen As Long, _
  693.     lpData As Byte)
  694.         
  695. Private Declare Function GetFileVersionInfoSize& _
  696.     Lib "version.dll" Alias "GetFileVersionInfoSizeA" _
  697.     (ByVal lptstrFilename As String, _
  698.     lpdwHandle As Long)
  699.  
  700. Private Declare Function VerQueryValue& Lib "version.dll" _
  701.     Alias "VerQueryValueA" _
  702.     (pBlock As Byte, _
  703.     ByVal lpSubBlock As String, _
  704.     lpBuffer As Long, _
  705.     puLen As Long)
  706.  
  707. ' Declaration to copy memory contents from one area to another
  708. Private Declare Sub CopyMem Lib "kernel32" _
  709.     Alias "RtlMoveMemory" _
  710.     (Destination As Any, _
  711.     Source As Any, _
  712.     ByVal Length As Long)
  713.  
  714. ' Call to get the current mouse position
  715. Private Declare Function GetCursorPos& Lib "user32" _
  716.     (lpPoint As POINTAPI)
  717.  
  718. ' Call to translate short file path to long file path
  719. ' (Win98 and Win2k and above only - see comments for the
  720. ' GetLongFilePath_Legacy procedure)
  721. Private Declare Function GetLongPathName Lib "kernel32" _
  722.     (ByRef pszShortPath As String, _
  723.     ByRef lpszLongPath As String, _
  724.     ByVal cchBuffer As Long) As Long
  725.  
  726. ' Call to determine OS version
  727. Private Declare Function GetVersionExA Lib "kernel32" _
  728.     (lpVersionInformation As OSVERSIONINFO) As Integer
  729.  
  730. ' Message box API declaration
  731. Private Declare Function MessageBoxIndirect Lib "user32" _
  732.     Alias "MessageBoxIndirectA" _
  733.     (lpMsgBoxParams As MSGBOXPARAMS) As Long
  734.       
  735. 'local variable(s) to hold property value(s)
  736. Private mvarCHMFile As String
  737. Private mvarHHALink As String
  738. Private mvarHHDefaultURL As String
  739. Private mvarHHInstalled As Boolean
  740. Private mvarHHKeyword As String
  741. Private mvarHHMsgText As String
  742. Private mvarHHMsgTitle As String
  743. Private mvarHHShowOnTop As Boolean
  744. Private mvarHHTopicID As Long
  745. Private mvarHHTopicURL As String
  746. Private mvarHHWindow As String
  747. Private mvarHHRegFileName As String
  748. Private mvarHHRegFilePath As String
  749. Private mvarHHRegFileExists As Boolean
  750. Private mvarHHPopupFile As String
  751. Private mvarHHPopupType As PopupType
  752. Private mvarHHPopupText As String
  753. Private mvarHHPopupID As Long
  754. Private mvarHHPopupTextColor As Long
  755. Private mvarHHPopupBackColor As Long
  756. Private mvarHHPopupCustomTextColor As Long
  757. Private mvarHHPopupCustomBackColor As Long
  758. Private mvarHHPopupCustomColors As Boolean
  759. Private mvarHHPopupTextFont As String
  760. Private mvarHHPopupTextSize As String
  761. Private mvarHHPopupTextBold As Boolean
  762. Private mvarHHPopupTextItalic As Boolean
  763. Private mvarHHPopupTextUnderline As Boolean
  764. Private mvarHHCtrlPath As String
  765. Private mvarHHVersion As String
  766. Private mvarIEVersion As String
  767. Private mvarHHFriendlyName As String
  768. Private mvarIEFriendlyName As String
  769.  
  770. ' Module-level variables
  771. Private strHTMLHelpPath As String
  772. Private strWindow As String
  773. Private strTopic As String
  774. Private lngTopicID As Long
  775.  
  776. Public Sub HHDisplayTopicURL(Optional ByRef CallingForm As Long)
  777.  
  778. ' Displays a specific topic via the HHTopicURL property
  779.  
  780.   On Error GoTo ErrHandler
  781.     
  782.   Dim hwnd As Long
  783.     
  784.   If ValidHHFile(mvarCHMFile) = False Then
  785.     Exit Sub
  786.   End If
  787.     
  788.   If EnsureFileExists(mvarCHMFile) = False Then
  789.     Exit Sub
  790.   End If
  791.     
  792.   If Trim(mvarHHWindow) = "" Then
  793.     If mvarHHShowOnTop Then
  794.       htmlHelpTopic CallingForm, mvarCHMFile, _
  795.           HH_DISPLAY_TOPIC, mvarHHTopicURL
  796.     Else
  797.       htmlHelpTopic hwnd, mvarCHMFile, _
  798.           HH_DISPLAY_TOPIC, mvarHHTopicURL
  799.     End If
  800.   Else
  801.     If mvarHHShowOnTop Then
  802.       htmlHelpTopic CallingForm, mvarCHMFile & ">" & mvarHHWindow, _
  803.           HH_DISPLAY_TOPIC, mvarHHTopicURL
  804.     Else
  805.       htmlHelpTopic hwnd, mvarCHMFile & ">" & mvarHHWindow, _
  806.           HH_DISPLAY_TOPIC, mvarHHTopicURL
  807.     End If
  808.   End If
  809.     
  810.   Exit Sub
  811.  
  812. ErrHandler:
  813.     
  814.   Select Case Err.Number
  815.   Case 91
  816.     MessageBoxExclamation "The HHDisplayContents method was called " & _
  817.         "without a form being specified, while HHShowOnTop " & _
  818.         "was set to True."
  819.     Exit Sub
  820.   Case Else
  821.       Resume Next
  822.   End Select
  823.       
  824. End Sub
  825.  
  826. Public Sub HHDisplayTopicID(Optional CallingForm As Long)
  827.  
  828. ' Displays a specific topic via the HHTopicID property
  829.     
  830.   On Error GoTo ErrHandler
  831.     
  832.   Dim hwnd As Long
  833.     
  834.   If ValidHHFile(mvarCHMFile) = False Then
  835.     Exit Sub
  836.   End If
  837.     
  838.   If EnsureFileExists(mvarCHMFile) = False Then
  839.     Exit Sub
  840.   End If
  841.   
  842.   If Trim(mvarHHWindow) = "" Then
  843.     If mvarHHShowOnTop Then
  844.       HTMLHelp CallingForm, mvarCHMFile, _
  845.           HH_HELP_CONTEXT, mvarHHTopicID
  846.     Else
  847.       HTMLHelp hwnd, mvarCHMFile, _
  848.           HH_HELP_CONTEXT, mvarHHTopicID
  849.     End If
  850.   Else
  851.     If mvarHHShowOnTop Then
  852.       HTMLHelp CallingForm, mvarCHMFile & ">" & mvarHHWindow, _
  853.           HH_HELP_CONTEXT, mvarHHTopicID
  854.     Else
  855.       HTMLHelp hwnd, mvarCHMFile & ">" & mvarHHWindow, _
  856.           HH_HELP_CONTEXT, mvarHHTopicID
  857.     End If
  858.   End If
  859.     
  860.   Exit Sub
  861.  
  862. ErrHandler:
  863.     
  864.   Select Case Err.Number
  865.   Case 91
  866.     MessageBoxExclamation "The HHDisplayContents method was called " & _
  867.         "without a form being specified, while HHShowOnTop " & _
  868.         "was set to True."
  869.     Exit Sub
  870.   Case Else
  871.     Resume Next
  872.   End Select
  873.       
  874. End Sub
  875.  
  876. Public Sub HHDisplaySearch(Optional ByRef CallingForm As Long)
  877.  
  878. ' Forces the Help window to display the Search tab
  879.  
  880.   On Error GoTo ErrHandler
  881.     
  882.   Dim hwnd As Long
  883.     
  884.   If ValidHHFile(mvarCHMFile) = False Then
  885.     Exit Sub
  886.   End If
  887.     
  888.   If EnsureFileExists(mvarCHMFile) = False Then
  889.     Exit Sub
  890.   End If
  891.     
  892.   Dim HH_FTS_QUERY As tagHH_FTS_QUERY
  893.  
  894.   With HH_FTS_QUERY
  895.     .cbStruct = Len(HH_FTS_QUERY)
  896.     .fStemmedSearch = 0&
  897.     .fTitleOnly = 0&
  898.     .fUniCodeStrings = 0&
  899.     .iProximity = 0&
  900.     .pszSearchQuery = ""
  901.     .pszWindow = ""
  902.     .fExecute = 1&
  903.   End With
  904.     
  905.   If Trim(mvarHHWindow) = "" Then
  906.     If mvarHHShowOnTop Then
  907.       HTMLHelpCallSearch CallingForm, _
  908.           mvarCHMFile, _
  909.           HH_DISPLAY_SEARCH, HH_FTS_QUERY
  910.     Else
  911.       HTMLHelpCallSearch hwnd, _
  912.           mvarCHMFile, _
  913.           HH_DISPLAY_SEARCH, HH_FTS_QUERY
  914.     End If
  915.   Else
  916.     If mvarHHShowOnTop Then
  917.       HTMLHelpCallSearch CallingForm, _
  918.           mvarCHMFile & ">" & mvarHHWindow, _
  919.           HH_DISPLAY_SEARCH, HH_FTS_QUERY
  920.     Else
  921.       HTMLHelpCallSearch hwnd, _
  922.           mvarCHMFile & ">" & mvarHHWindow, _
  923.           HH_DISPLAY_SEARCH, HH_FTS_QUERY
  924.     End If
  925.   End If
  926.   Exit Sub
  927.  
  928. ErrHandler:
  929.     
  930.   Select Case Err.Number
  931.   Case 91
  932.     MessageBoxExclamation "The HHDisplayContents method was called " & _
  933.         "without a form being specified, while HHShowOnTop " & _
  934.         "was set to True."
  935.     Exit Sub
  936.   Case Else
  937.     Resume Next
  938.   End Select
  939.       
  940. End Sub
  941.  
  942. Public Sub HHDisplayKeyword(Optional ByRef CallingForm As Long)
  943.  
  944. ' Displays a topic specified by the HHKeyword property.
  945. ' This will search for a KLink keyword in the topics
  946. ' themselves.  Also searches the entries of an Index
  947. ' file (*.hhk) used in a tripane window.
  948.  
  949.   On Error GoTo ErrHandler
  950.     
  951.   Dim hwnd As Long
  952.     
  953.   If ValidHHFile(mvarCHMFile) = False Then
  954.     Exit Sub
  955.   End If
  956.     
  957.   If EnsureFileExists(mvarCHMFile) = False Then
  958.     Exit Sub
  959.   End If
  960.     
  961.   If mvarHHShowOnTop Then
  962.     htmlHelpTopic CallingForm, mvarCHMFile, _
  963.         HH_DISPLAY_TOPIC, vbNullString
  964.   Else
  965.     htmlHelpTopic hwnd, mvarCHMFile, _
  966.         HH_DISPLAY_TOPIC, vbNullString
  967.   End If
  968.     
  969.   Dim ALinkStruct As tagHH_AKLINK
  970.   
  971.   ALinkStruct.cbStruct = Len(ALinkStruct)
  972.   ALinkStruct.fReserved = False
  973.   ALinkStruct.pszKeywords = mvarHHKeyword
  974.     
  975.   ' Translate empty strings to Null strings
  976.   If mvarHHDefaultURL = "" Then
  977.     mvarHHDefaultURL = vbNullString
  978.   End If
  979.     
  980.   If mvarHHMsgText = "" Then
  981.     mvarHHMsgText = vbNullString
  982.   End If
  983.     
  984.   If mvarHHMsgTitle = "" Then
  985.     mvarHHMsgTitle = vbNullString
  986.   End If
  987.     
  988.   ' Set up the default topic to use if the
  989.   ' specified keyword is not found.  This is
  990.   ' set via the HHDefaultURL property.
  991.   ALinkStruct.pszUrl = mvarHHDefaultURL
  992.     
  993.   ' Set up the message box to display if the
  994.   ' specified keyword is not found.  These are
  995.   ' set via the HHMsgText and HHMshgTitle properties.
  996.   ALinkStruct.pszMsgText = mvarHHMsgText
  997.   ALinkStruct.pszMsgTitle = mvarHHMsgTitle
  998.     
  999.   ' Use the HHWindow property if it's set.
  1000.   If Trim(mvarHHWindow) <> "" Then
  1001.     ALinkStruct.pszWindow = mvarHHWindow
  1002.   End If
  1003.     
  1004.   ' Set to False to enable the default URL
  1005.   ' and message box functions.
  1006.   ALinkStruct.fIndexOnFail = False
  1007.     
  1008.   If mvarHHShowOnTop Then
  1009.     HTMLHelpKeyWord CallingForm, mvarCHMFile, _
  1010.         HH_KEYWORD_LOOKUP, ALinkStruct
  1011.   Else
  1012.     HTMLHelpKeyWord hwnd, mvarCHMFile, _
  1013.         HH_KEYWORD_LOOKUP, ALinkStruct
  1014.   End If
  1015.     
  1016.   Exit Sub
  1017.  
  1018. ErrHandler:
  1019.     
  1020.   Select Case Err.Number
  1021.   Case 91
  1022.     MessageBoxExclamation "The HHDisplayContents method was called " & _
  1023.         "without a form being specified, while HHShowOnTop " & _
  1024.         "was set to True."
  1025.     Exit Sub
  1026.   Case Else
  1027.     Resume Next
  1028.   End Select
  1029.       
  1030. End Sub
  1031.  
  1032. Public Sub HHDisplayIndex(Optional ByRef CallingForm As Long)
  1033.  
  1034. ' Force the Help window to display the Index file
  1035. ' (*.hhk) in the left pane
  1036.  
  1037.   On Error GoTo ErrHandler
  1038.     
  1039.   Dim hwnd As Long
  1040.     
  1041.   If ValidHHFile(mvarCHMFile) = False Then
  1042.     Exit Sub
  1043.   End If
  1044.     
  1045.   If EnsureFileExists(mvarCHMFile) = False Then
  1046.     Exit Sub
  1047.   End If
  1048.   
  1049.   If Trim(mvarHHWindow) = "" Then
  1050.     If mvarHHShowOnTop Then
  1051.       HTMLHelp CallingForm, mvarCHMFile, _
  1052.           HH_DISPLAY_INDEX, 0
  1053.     Else
  1054.       HTMLHelp hwnd, mvarCHMFile, _
  1055.           HH_DISPLAY_INDEX, 0
  1056.     End If
  1057.   Else
  1058.     If mvarHHShowOnTop Then
  1059.       HTMLHelp CallingForm, mvarCHMFile & ">" & mvarHHWindow, _
  1060.           HH_DISPLAY_INDEX, 0
  1061.     Else
  1062.       HTMLHelp hwnd, mvarCHMFile & ">" & mvarHHWindow, _
  1063.           HH_DISPLAY_INDEX, 0
  1064.     End If
  1065.   End If
  1066.     
  1067.   Exit Sub
  1068.  
  1069. ErrHandler:
  1070.     
  1071.   Select Case Err.Number
  1072.   Case 91
  1073.     MessageBoxExclamation "The HHDisplayContents method was called " & _
  1074.         "without a form being specified, while HHShowOnTop " & _
  1075.         "was set to True."
  1076.     Exit Sub
  1077.   Case Else
  1078.     Resume Next
  1079.   End Select
  1080.       
  1081. End Sub
  1082.  
  1083. Public Sub HHDisplayContents(Optional ByRef CallingForm As Long)
  1084.     
  1085. ' Force the Help window to display the Contents file
  1086. ' (*.hhc) in the left pane
  1087.     
  1088.   On Error GoTo ErrHandler
  1089.     
  1090.   Dim hwnd As Long
  1091.     
  1092.   If ValidHHFile(mvarCHMFile) = False Then
  1093.     Exit Sub
  1094.   End If
  1095.     
  1096.   If EnsureFileExists(mvarCHMFile) = False Then
  1097.     Exit Sub
  1098.   End If
  1099.     
  1100.   If Trim(mvarHHWindow) = "" Then
  1101.     If mvarHHShowOnTop Then
  1102.       HTMLHelp CallingForm, mvarCHMFile, _
  1103.           HH_DISPLAY_TOC, 0
  1104.     Else
  1105.       HTMLHelp hwnd, mvarCHMFile, _
  1106.           HH_DISPLAY_TOC, 0
  1107.     End If
  1108.   Else
  1109.     If mvarHHShowOnTop Then
  1110.       HTMLHelp CallingForm, mvarCHMFile & ">" & mvarHHWindow, _
  1111.           HH_DISPLAY_TOC, 0
  1112.     Else
  1113.       HTMLHelp hwnd, mvarCHMFile & ">" & mvarHHWindow, _
  1114.           HH_DISPLAY_TOC, 0
  1115.     End If
  1116.   End If
  1117.     
  1118.   Exit Sub
  1119.  
  1120. ErrHandler:
  1121.     
  1122.   Select Case Err.Number
  1123.   Case 91
  1124.     MessageBoxExclamation "The HHDisplayContents method was called " & _
  1125.         "without a form being specified, while HHShowOnTop " & _
  1126.         "was set to True."
  1127.     Exit Sub
  1128.   Case Else
  1129.     Resume Next
  1130.   End Select
  1131.       
  1132. End Sub
  1133.  
  1134. Public Sub HHDisplayALink(Optional ByRef CallingForm As Long)
  1135.  
  1136. ' Displays a topic specified by the HHALink property.
  1137.  
  1138.   On Error GoTo ErrHandler
  1139.     
  1140.   Dim hwnd As Long
  1141.     
  1142.   If ValidHHFile(mvarCHMFile) = False Then
  1143.     Exit Sub
  1144.   End If
  1145.     
  1146.   If EnsureFileExists(mvarCHMFile) = False Then
  1147.     Exit Sub
  1148.   End If
  1149.  
  1150.   Dim ALinkStruct As tagHH_AKLINK
  1151.   
  1152.   ALinkStruct.cbStruct = Len(ALinkStruct)
  1153.   ALinkStruct.fReserved = False
  1154.   ALinkStruct.pszKeywords = mvarHHALink
  1155.     
  1156.   ' Translate empty strings to Null strings
  1157.   If mvarHHDefaultURL = "" Then
  1158.     mvarHHDefaultURL = vbNullString
  1159.   End If
  1160.     
  1161.   If mvarHHMsgText = "" Then
  1162.     mvarHHMsgText = vbNullString
  1163.   End If
  1164.     
  1165.   If mvarHHMsgTitle = "" Then
  1166.     mvarHHMsgTitle = vbNullString
  1167.   End If
  1168.     
  1169.   ' Set up the default topic to use if the
  1170.   ' specified keyword is not found.  This is
  1171.   ' set via the HHDefaultURL property.
  1172.   ALinkStruct.pszUrl = mvarHHDefaultURL
  1173.     
  1174.   ' Set up the message box to display if the
  1175.   ' specified keyword is not found.  These are
  1176.   ' set via the HHMsgText and HHMshgTitle properties.
  1177.   ALinkStruct.pszMsgText = mvarHHMsgText
  1178.   ALinkStruct.pszMsgTitle = mvarHHMsgTitle
  1179.     
  1180.   ' Use the HHWindow property if it's set.
  1181.   If Trim(mvarHHWindow) <> "" Then
  1182.     ALinkStruct.pszWindow = mvarHHWindow
  1183.   End If
  1184.     
  1185.   ' Set to False to enable the default URL
  1186.   ' and message box functions.
  1187.   ALinkStruct.fIndexOnFail = False
  1188.   
  1189.   If mvarHHShowOnTop Then
  1190.     HTMLHelpKeyWord CallingForm, mvarCHMFile, _
  1191.         HH_ALINK_LOOKUP, ALinkStruct
  1192.   Else
  1193.     HTMLHelpKeyWord hwnd, mvarCHMFile, _
  1194.         HH_ALINK_LOOKUP, ALinkStruct
  1195.   End If
  1196.     
  1197.   Exit Sub
  1198.  
  1199. ErrHandler:
  1200.     
  1201.   Select Case Err.Number
  1202.   Case 91
  1203.     MessageBoxExclamation "The HHDisplayContents method was called " & _
  1204.         "without a form being specified, while HHShowOnTop " & _
  1205.         "was set to True."
  1206.     Exit Sub
  1207.   Case Else
  1208.     Resume Next
  1209.   End Select
  1210.       
  1211. End Sub
  1212.  
  1213. Public Sub HHRegister(FileToRegister As String)
  1214.  
  1215. ' Registers the specified HTML Help file in
  1216. ' HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\HTML Help
  1217.  
  1218.   Dim lngHandle As Long
  1219.   Dim lngDisposition As Long
  1220.   Dim lngLenData As Long
  1221.   Dim lngResult As Long
  1222.   Dim strValue As String
  1223.   Dim secSecAttributes As SECURITY_ATTRIBUTES
  1224.   Dim strFilePath As String
  1225.   Dim intPosition As Integer
  1226.   Dim intLength As Integer
  1227.   
  1228.   If FileToRegister = "" Then Exit Sub
  1229.   
  1230.   If ValidHHFile(FileToRegister) = False Then Exit Sub
  1231.   
  1232.   GetLongPath_Legacy FileToRegister, FileToRegister, 256
  1233.   
  1234.   HHCheckRegistry FileToRegister
  1235.     
  1236.   If (mvarHHRegFileName <> "") Then
  1237.       
  1238.     ' The file is registered to begin with,
  1239.     ' so we need to say so and exit.
  1240.     MessageBoxInformation "The file " & FileToRegister & " is already registered.  " & _
  1241.         "HHRegister will not be run as no action need be taken."
  1242.     Exit Sub
  1243.       
  1244.   End If
  1245.   
  1246.   ' Copy it to get the path later
  1247.   strFilePath = FileToRegister
  1248.   
  1249.   If ValidHHFile(FileToRegister) = False Then
  1250.     Exit Sub
  1251.   Else
  1252.   
  1253.     If EnsureFileExists(FileToRegister) = False Then
  1254.       Exit Sub
  1255.     End If
  1256.     If InStr(FileToRegister, "\") = 0 Then
  1257.       MessageBoxExclamation "Cannot register " & FileToRegister & " without having a supplied path."""
  1258.       Exit Sub
  1259.     Else
  1260.       ' strip the file name itself off the path
  1261.       intPosition = 1
  1262.     
  1263.       Do While intPosition <> 0
  1264.         intLength = Len(FileToRegister)
  1265.         intPosition = InStr(1, FileToRegister, "\")
  1266.         FileToRegister = Right(FileToRegister, (intLength - intPosition))
  1267.       Loop
  1268.     
  1269.       ' Get the registered path
  1270.       strFilePath = Left(strFilePath, Len(strFilePath) - Len(FileToRegister))
  1271.     
  1272.       ' Register it
  1273.       lngResult = 99
  1274.  
  1275.       lngResult = RegCreateKeyEx(HKEY_LOCAL_MACHINE, _
  1276.           "Software\Microsoft\Windows\HTML Help", _
  1277.           0, _
  1278.           "", _
  1279.           REG_OPTION_NON_VOLATILE, _
  1280.           KEY_CREATE_SUB_KEY Or KEY_SET_VALUE, _
  1281.           secSecAttributes, _
  1282.           lngHandle, _
  1283.           lngDisposition)
  1284.       
  1285.       If lngResult <> ERROR_SUCCESS Then
  1286.         GoTo WriteRegValueError
  1287.       End If
  1288.     
  1289.       strValue = strFilePath
  1290.       lngLenData = Len(strValue) + 1
  1291.       lngResult = RegSetValueEx(lngHandle, _
  1292.           FileToRegister, _
  1293.           0, _
  1294.           REG_SZ, _
  1295.           ByVal strValue, _
  1296.           lngLenData)
  1297.     
  1298.       If lngResult = ERROR_SUCCESS Then
  1299.         lngResult = RegCloseKey(lngHandle)
  1300.         Exit Sub
  1301.       End If
  1302.       
  1303.     End If
  1304.   End If
  1305.   
  1306.   HHCheckRegistry CStr(FileToRegister)
  1307.   
  1308.   Exit Sub
  1309.  
  1310. WriteRegValueError:
  1311.   MessageBoxExclamation "HTML Help Class: HHRegister Error"
  1312.  
  1313. End Sub
  1314.  
  1315. Public Sub HHUnRegister(FileToUnRegister As String)
  1316.  
  1317. ' Deletes the entry for the specified HTML Help file from
  1318. ' HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\HTML Help
  1319.  
  1320.   Dim lngResult As Long
  1321.   Dim strFilePath As String
  1322.   Dim intPosition As Integer
  1323.   Dim intLength As Integer
  1324.   Dim lngHandle As Long
  1325.   
  1326.   If FileToUnRegister = "" Then Exit Sub
  1327.   
  1328.   If ValidHHFile(FileToUnRegister) = False Then Exit Sub
  1329.     
  1330.   GetLongPath_Legacy FileToUnRegister, FileToUnRegister, 256
  1331.   
  1332.   HHCheckRegistry FileToUnRegister
  1333.     
  1334.   If (mvarHHRegFileName = "") Then
  1335.       
  1336.     ' The file isn't registered to begin with,
  1337.     ' so we need to say so and exit.
  1338.     MessageBoxInformation "The file " & FileToUnRegister & " is not registered.  " & _
  1339.         "HHUnRegister will not be run as no action need be taken."
  1340.       
  1341.     Exit Sub
  1342.       
  1343.   End If
  1344.     
  1345.   ' strip the file name itself off the path
  1346.   intPosition = 1
  1347.     
  1348.   Do While intPosition <> 0
  1349.     intLength = Len(FileToUnRegister)
  1350.     intPosition = InStr(1, FileToUnRegister, "\")
  1351.     FileToUnRegister = Right(FileToUnRegister, (intLength - intPosition))
  1352.   Loop
  1353.     
  1354.   ' Delete the entry
  1355.   lngResult = RegOpenKeyEx(HKEY_LOCAL_MACHINE, _
  1356.       "Software\Microsoft\Windows\HTML Help", _
  1357.       0, _
  1358.       KEY_SET_VALUE, _
  1359.       lngHandle)
  1360.       
  1361.   If lngResult = ERROR_SUCCESS Then
  1362.     lngResult = RegDeleteValue(lngHandle, FileToUnRegister)
  1363.   End If
  1364.   
  1365.   HHCheckRegistry CStr(FileToUnRegister)
  1366.   
  1367. End Sub
  1368.  
  1369. Public Function HHCheckRegistry(ByRef FileToCheck As String) As Variant
  1370.  
  1371. ' Verifies the specified HTML Help file has been registered in
  1372. ' HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\HTML Help
  1373.  
  1374.   Dim sValues As String
  1375.   Dim intLength As Integer
  1376.   Dim boolResult As Boolean
  1377.   Dim intPosition As Integer
  1378.   Dim intFileNamePos As Integer
  1379.   Dim varRegValues As HH_REG_VALUES
  1380.   Dim strTempFileName As String
  1381.   
  1382.   ' Reassign the file name so the original
  1383.   ' doesn't become mangled
  1384.   strTempFileName = FileToCheck
  1385.   
  1386.   If strTempFileName = "" Then
  1387.     Exit Function
  1388.   End If
  1389.   
  1390.   HHCheckRegistry = False
  1391.   mvarHHRegFileExists = False
  1392.   
  1393.   If ValidHHFile(strTempFileName) = False Then
  1394.     Exit Function
  1395.   Else
  1396.     ' strip the file name itself off the path
  1397.     intPosition = 1
  1398.     
  1399.     Do While intPosition <> 0
  1400.       intLength = Len(strTempFileName)
  1401.       intPosition = InStr(1, strTempFileName, "\")
  1402.       strTempFileName = Right(strTempFileName, (intLength - intPosition))
  1403.     Loop
  1404.     
  1405.     ' Verify it
  1406.     varRegValues = EnumRegValue("HKLM", "Software\Microsoft\Windows\HTML Help", sValues, strTempFileName)
  1407.     
  1408.     With varRegValues
  1409.       If .pszFileName = strTempFileName Then
  1410.         
  1411.         ' Load the verified file name into the HHRegFileName
  1412.         ' property, and the registered path of the file into
  1413.         ' the HHRegFilePath property.
  1414.         Dim tempHHRegFilePath As String
  1415.         mvarHHRegFileName = .pszFileName
  1416.         tempHHRegFilePath = Right(.pszFilePath, Len(.pszFilePath) - InStr(.pszFilePath, "="))
  1417.         tempHHRegFilePath = Left(tempHHRegFilePath, (Len(tempHHRegFilePath) - 2))
  1418.         
  1419.         GetLongPath_Legacy tempHHRegFilePath, mvarHHRegFilePath, 256
  1420.         
  1421.         Dim lpFindFileData As WIN32_FIND_DATA
  1422.         Dim lngHandle As Long
  1423.         
  1424.         ' Verify the HTML Help file exists according to the
  1425.         ' registry data.
  1426.         boolResult = EnsureFileExists(mvarHHRegFilePath & "\" & mvarHHRegFileName)
  1427.         
  1428.         If boolResult Then
  1429.         
  1430.           ' If the file's in the registered location,
  1431.           ' set HHRegFileExists to True.
  1432.           mvarHHRegFileExists = True
  1433.           
  1434.         End If
  1435.       Else
  1436.         
  1437.         ' If the file isn't registered, clear the
  1438.         ' HHRegFileName and HHRegFilePath properties.
  1439.         mvarHHRegFileName = ""
  1440.         mvarHHRegFilePath = ""
  1441.         
  1442.       End If
  1443.     End With
  1444.     
  1445.   End If
  1446.   
  1447. End Function
  1448.  
  1449. Public Sub HHClose()
  1450.   
  1451. ' Closes all open HTML Help windows.  Be careful when
  1452. ' using this as it closes everything, not just the
  1453. ' HTML Help windows for this app.
  1454.   
  1455.   On Error Resume Next
  1456.     
  1457.   Dim hwnd As Long
  1458.  
  1459.   HTMLHelp hwnd, mvarCHMFile, HH_CLOSE_ALL, 0
  1460.     
  1461. End Sub
  1462.  
  1463. Public Function HHSetHelpFile(ByVal intSelHelpFile As Integer) As String
  1464.   
  1465. ' Set the string variable to
  1466. ' include the application path
  1467.  
  1468.   Select Case intSelHelpFile
  1469.   Case 1
  1470.     HHSetHelpFile = App.Path & "\Library.chm"
  1471.   Case 2
  1472.     ' Popup text file for the above CHM
  1473.     HHSetHelpFile = "Library.txt"
  1474.   Case Else
  1475.     ' list other HTML Help files here
  1476.   End Select
  1477.   
  1478. End Function
  1479.  
  1480. Public Sub HHDisplayPopup(ByRef CallingForm As Long)
  1481.  
  1482. ' Displays a text popup from any of three sources
  1483. ' and with a number of options
  1484.   
  1485.   If mvarHHPopupType = 0 Then
  1486.     Exit Sub
  1487.   End If
  1488.  
  1489.   Dim pPoint As POINTAPI
  1490.   Dim hPopup As tagHH_POPUP
  1491.   Dim rRect As RECT
  1492.   Dim hwnd As Long
  1493.   Dim strFontString As String
  1494.   
  1495.   If mvarHHPopupType = HH_CHM_POPUP Then
  1496.     
  1497.     ' Check for a valid CHM if that option is selected
  1498.     
  1499.     If ValidHHFile(mvarCHMFile) = False Then
  1500.       Exit Sub
  1501.     End If
  1502.     
  1503.     If EnsureFileExists(mvarCHMFile) = False Then
  1504.       Exit Sub
  1505.     End If
  1506.     
  1507.   End If
  1508.   
  1509.   ' Get the current mouse pointer position
  1510.   GetCursorPos& pPoint
  1511.   
  1512.   ' Set the margins of the popup
  1513.   With rRect
  1514.     .Bottom = -1
  1515.     .Left = -1
  1516.     .Right = -1
  1517.     .Top = -1
  1518.   End With
  1519.   
  1520.   With hPopup
  1521.     .cbStruct = Len(hPopup)
  1522.   
  1523.     ' Clear any previously used color scheme
  1524.     .clrForeground = 0
  1525.     .clrBackground = 0
  1526.     
  1527.     If mvarHHPopupType = HH_RESOURCE_POPUP Then
  1528.     
  1529.       ' Fudge the Resource function by actually
  1530.       ' using HH_TEXT_POPUP
  1531.       .pszText = LoadResString(mvarHHPopupID)
  1532.       .hinst = 0
  1533.       
  1534.     ElseIf mvarHHPopupType = HH_TEXT_POPUP Then
  1535.     
  1536.       .idString = 0
  1537.       
  1538.       ' End the sub if no string is supplied
  1539.       If mvarHHPopupText = "" Then
  1540.         Exit Sub
  1541.       End If
  1542.       .pszText = mvarHHPopupText
  1543.       
  1544.     Else
  1545.       
  1546.       .idString = mvarHHPopupID
  1547.       .pszText = vbNullString
  1548.       
  1549.     End If
  1550.     
  1551.     ' Match the popup coordinates to the current
  1552.     ' mouse pointer coordinates
  1553.     .pt = pPoint
  1554.     
  1555.     If mvarHHPopupCustomColors = True Then
  1556.       .clrForeground = mvarHHPopupCustomTextColor
  1557.       .clrBackground = mvarHHPopupCustomBackColor
  1558.     Else
  1559.       .clrForeground = mvarHHPopupTextColor
  1560.       .clrBackground = mvarHHPopupBackColor
  1561.     End If
  1562.     
  1563.     .rcMargins = rRect
  1564.     
  1565.     Dim strBold As String
  1566.     Dim strItalic As String
  1567.     Dim strUnderline As String
  1568.     
  1569.     If mvarHHPopupTextFont = "" Then
  1570.       mvarHHPopupTextFont = "Arial"
  1571.     End If
  1572.     
  1573.     If mvarHHPopupTextSize = "" Then
  1574.       mvarHHPopupTextSize = "10"
  1575.     End If
  1576.     
  1577.     If mvarHHPopupTextBold = True Then
  1578.       strBold = "Bold "
  1579.     Else
  1580.       strBold = ""
  1581.     End If
  1582.     
  1583.     If mvarHHPopupTextItalic = True Then
  1584.       strItalic = "Italic "
  1585.     Else
  1586.       strItalic = ""
  1587.     End If
  1588.     
  1589.     If mvarHHPopupTextUnderline = True Then
  1590.       strUnderline = "Underline"
  1591.     Else
  1592.       strUnderline = ""
  1593.     End If
  1594.     
  1595.     strFontString = mvarHHPopupTextFont & ", " & _
  1596.         mvarHHPopupTextSize & ", ascii, " & _
  1597.         strBold & strItalic & strUnderline
  1598.         
  1599.     .pszFont = strFontString
  1600.     
  1601.   End With
  1602.   
  1603.   Select Case mvarHHPopupType
  1604.   Case HH_CHM_POPUP
  1605.   
  1606.     If ValidPopupFile(mvarHHPopupFile) = False Then
  1607.       Exit Sub
  1608.     Else
  1609.       htmlHelpTextPopup CallingForm, _
  1610.         mvarCHMFile & "::/" & mvarHHPopupFile, _
  1611.         HH_DISPLAY_TEXT_POPUP, hPopup
  1612.     End If
  1613.     
  1614.   Case HH_RESOURCE_POPUP
  1615.     htmlHelpTextPopup CallingForm, vbNullString, _
  1616.       HH_DISPLAY_TEXT_POPUP, hPopup
  1617.     
  1618.   Case HH_TEXT_POPUP
  1619.     htmlHelpTextPopup CallingForm, vbNullString, _
  1620.       HH_DISPLAY_TEXT_POPUP, hPopup
  1621.       
  1622.   Case Else
  1623.     Exit Sub
  1624.   End Select
  1625.   
  1626.   ' Clear the color and font scheme before the next use
  1627.   mvarHHPopupCustomTextColor = 0
  1628.   mvarHHPopupCustomBackColor = 0
  1629.   mvarHHPopupTextColor = 0
  1630.   mvarHHPopupBackColor = 0
  1631.   mvarHHPopupTextFont = "Arial"
  1632.   mvarHHPopupTextSize = "10"
  1633.   mvarHHPopupTextBold = False
  1634.   mvarHHPopupTextItalic = False
  1635.   mvarHHPopupTextUnderline = False
  1636.   
  1637. End Sub
  1638.  
  1639. Public Sub HHInvokeWhatsThisHelp(CallingForm As Long)
  1640.   
  1641. ' Sets the mouse pointer to the What's This pointer.
  1642. ' When the left button is clicked again, What's This
  1643. ' is invoked for the control below the cursor.
  1644.  
  1645.   DefWindowProc CallingForm, WM_SYSCOMMAND, _
  1646.       SC_CONTEXTHELP, 0
  1647.  
  1648. End Sub
  1649.  
  1650. Public Function HHVerifyMinConfig(MinHHVersion As HHVersion, _
  1651.     MinIEVersion As IEVersion) As Boolean
  1652.   
  1653. ' Verifies the minimum HTML Help and IE versions
  1654. ' as specified by the developer.
  1655.     
  1656.   Dim boolHHVerified As Boolean
  1657.   Dim boolIEVerified As Boolean
  1658.   
  1659.   GetHHVersion
  1660.   
  1661.   GetIEVersion
  1662.   
  1663.   HHVerifyMinConfig = False
  1664.   
  1665.   Select Case MinHHVersion
  1666.   Case HH_1_0
  1667.     If mvarHHVersion >= extHH_1_0 Then
  1668.       boolHHVerified = True
  1669.     End If
  1670.   Case HH_1_1
  1671.     If mvarHHVersion >= extHH_1_1 Then
  1672.       boolHHVerified = True
  1673.     End If
  1674.   Case HH_1_1A
  1675.     If mvarHHVersion >= extHH_1_1A Then
  1676.       boolHHVerified = True
  1677.     End If
  1678.   Case HH_1_1B
  1679.     If mvarHHVersion >= extHH_1_1B Then
  1680.       boolHHVerified = True
  1681.     End If
  1682.   Case HH_1_2
  1683.     If mvarHHVersion >= extHH_1_2 Then
  1684.       boolHHVerified = True
  1685.     End If
  1686.   Case HH_1_21
  1687.     If mvarHHVersion >= extHH_1_21 Then
  1688.       boolHHVerified = True
  1689.     End If
  1690.   Case HH_1_21A
  1691.     If mvarHHVersion >= extHH_1_21A Then
  1692.       boolHHVerified = True
  1693.     End If
  1694.   Case HH_1_22
  1695.     If mvarHHVersion >= extHH_1_22 Then
  1696.       boolHHVerified = True
  1697.     End If
  1698.   Case HH_1_22
  1699.     If mvarHHVersion >= extHH_1_3 Then
  1700.       boolHHVerified = True
  1701.     End If
  1702.   Case Else
  1703.     mvarHHVersion = extUNKNOWN
  1704.   End Select
  1705.  
  1706.   Select Case MinIEVersion
  1707.   Case IE_3_0
  1708.     If mvarIEVersion >= extIE_3_0 Then
  1709.       boolIEVerified = True
  1710.     End If
  1711.   Case IE_3_0_OSR2
  1712.     If mvarIEVersion >= extIE_3_0_OSR2 Then
  1713.       boolIEVerified = True
  1714.     End If
  1715.   Case IE_3_01
  1716.     If mvarIEVersion >= extIE_3_01 Then
  1717.       boolIEVerified = True
  1718.     End If
  1719.   Case IE_3_02
  1720.     If mvarIEVersion >= extIE_3_02 Then
  1721.       boolIEVerified = True
  1722.     End If
  1723.   Case IE_4_0_PP2
  1724.     If mvarIEVersion >= extIE_4_0_PP2 Then
  1725.       boolIEVerified = True
  1726.     End If
  1727.   Case IE_4_0
  1728.     If mvarIEVersion >= extIE_4_0 Then
  1729.       boolIEVerified = True
  1730.     End If
  1731.   Case IE_4_01
  1732.     If mvarIEVersion >= extIE_4_01 Then
  1733.       boolIEVerified = True
  1734.     End If
  1735.   Case IE_4_01_SP1
  1736.     If mvarIEVersion >= extIE_4_01_SP1 Then
  1737.       boolIEVerified = True
  1738.     End If
  1739.   Case IE_4_01_SP2
  1740.     If mvarIEVersion >= extIE_4_01_SP2 Then
  1741.       boolIEVerified = True
  1742.     End If
  1743.   Case IE_5_0_Beta1
  1744.     If mvarIEVersion >= extIE_5_0_Beta1 Then
  1745.       boolIEVerified = True
  1746.     End If
  1747.   Case IE_5_0_Beta2
  1748.     If mvarIEVersion >= extIE_5_0_Beta2 Then
  1749.       boolIEVerified = True
  1750.     End If
  1751.   Case IE_5_0
  1752.     If mvarIEVersion >= extIE_5_0 Then
  1753.       boolIEVerified = True
  1754.     End If
  1755.   Case IE_5_0A
  1756.     If mvarIEVersion >= extIE_5_0A Then
  1757.       boolIEVerified = True
  1758.     End If
  1759.   Case IE_5_0B
  1760.     If mvarIEVersion >= extIE_5_0B Then
  1761.       boolIEVerified = True
  1762.     End If
  1763.   Case IE_5_0C
  1764.     If mvarIEVersion >= extIE_5_0C Then
  1765.       boolIEVerified = True
  1766.     End If
  1767.   Case Else
  1768.     mvarIEVersion = extUNKNOWN
  1769.   End Select
  1770.   
  1771.   GetHHFriendlyName
  1772.   GetIEFriendlyName
  1773.   
  1774.   HHVerifyMinConfig = (boolHHVerified And boolIEVerified)
  1775.   
  1776. End Function
  1777.  
  1778. Private Function GetVersionInfo(FileName) As String
  1779.  
  1780. ' Retrieves the file version information for
  1781. ' the specified file
  1782.   
  1783.   Dim varVersionSize As Long
  1784.   Dim varVersionHwnd As Long
  1785.   Dim bytVerBuf() As Byte
  1786.   Dim lngResult As Long
  1787.   Dim ffi As VS_FIXEDFILEINFO
  1788.   Dim ffiAddr As Long
  1789.   Dim ffiLen As Long
  1790.   Dim di As Long
  1791.   
  1792.   varVersionSize = GetFileVersionInfoSize(FileName, varVersionHwnd)
  1793.   If varVersionSize > 64000 Then varVersionSize = 64000
  1794.   
  1795.   ReDim bytVerBuf(varVersionSize + 1)
  1796.   
  1797.   lngResult = GetFileVersionInfo(FileName, varVersionHwnd, varVersionSize, bytVerBuf(0))
  1798.   di = VerQueryValue(bytVerBuf(0), "\", ffiAddr, ffiLen)
  1799.   
  1800.   CopyMem ffi, ByVal ffiAddr, Len(ffi)
  1801.   
  1802.   GetVersionInfo = Format$(ffi.dwFileVersionMSh) & "." & _
  1803.       Format$(ffi.dwFileVersionMSl, "00") & "."
  1804.       
  1805.   If ffi.dwFileVersionLSh > 0 Then
  1806.     GetVersionInfo = GetVersionInfo & Format$(ffi.dwFileVersionLSh, "00") & "." & _
  1807.         Format$(ffi.dwFileVersionLSl, "00")
  1808.   Else
  1809.     GetVersionInfo = GetVersionInfo & Format$(ffi.dwFileVersionLSl, "0000")
  1810.   End If
  1811.   
  1812. End Function
  1813.  
  1814. Private Function ValidHHFile(FileToVerify) As Boolean
  1815.  
  1816. ' Verifies the suffix for the specified CHM
  1817. ' Note this procedure does not verify actual CHM
  1818.   
  1819.   ValidHHFile = True
  1820.   
  1821.   If Right(FileToVerify, 3) <> "chm" Then
  1822.     MessageBoxExclamation FileToVerify & " is not a valid HTML Help file."
  1823.     Exit Function
  1824.   End If
  1825.  
  1826. End Function
  1827.  
  1828. Private Function ValidPopupFile(FileToVerify) As Boolean
  1829.  
  1830. ' Verifies the suffix for the specified popup text file
  1831. ' Note this procedure does not verify actual popup text file
  1832.   
  1833.   ValidPopupFile = True
  1834.   
  1835.   If Right(FileToVerify, 3) <> "txt" Then
  1836.     MessageBoxExclamation "The file specified as the text popup source, '" & _
  1837.         FileToVerify & "', is not a valid popup file."
  1838.     Exit Function
  1839.   End If
  1840.  
  1841. End Function
  1842.  
  1843. Public Function EnsureFileExists(ByRef FileToFind As String) As Boolean
  1844.  
  1845. ' Ensures the specified file exists in its specified location
  1846.  
  1847.   Dim lpFindFileData As WIN32_FIND_DATA
  1848.   Dim lngHandle As Long
  1849.   
  1850.   EnsureFileExists = True
  1851.   
  1852.   If (InStr(FileToFind, "\") = 0) Then
  1853.     ' Check to see if the file is registered
  1854.     HHCheckRegistry FileToFind
  1855.     
  1856.     If mvarHHRegFileName <> "" Then
  1857.       ' If it's registered, use the registry info
  1858.       FileToFind = mvarHHRegFilePath & mvarHHRegFileName
  1859.     Else
  1860.       ' Otherwise, assume it's in App.Path
  1861.       FileToFind = App.Path & "\" & FileToFind
  1862.     End If
  1863.   End If
  1864.   
  1865.   lngHandle = FindFirstFile(FileToFind, lpFindFileData)
  1866.   
  1867.   If (lngHandle) = INVALID_HANDLE_VALUE Then
  1868.         
  1869.     MessageBoxExclamation "The file " & FileToFind & " does not exist." & Chr(10) & _
  1870.         "Please make sure the correct path and file name have been specified."
  1871.         
  1872.     EnsureFileExists = False
  1873.     
  1874.   Else
  1875.   
  1876.     FindClose lngHandle
  1877.     
  1878.   End If
  1879.   
  1880. End Function
  1881.  
  1882. Private Function EnumRegValue(ByVal strTopKey As String, _
  1883.     ByVal strSubKey As String, _
  1884.     strValues As String, _
  1885.     FileToCheck As String) As HH_REG_VALUES
  1886.  
  1887. ' Enumerates registry values
  1888.  
  1889.   Dim strTempFileName As String
  1890.   Dim lngTopKey As Long
  1891.   Dim lngHandle As Long
  1892.   Dim lngResult As Long
  1893.   Dim lngValueLen As Long
  1894.   Dim lngIndex As Long
  1895.   Dim lngValue As Long
  1896.   Dim lngValueType As Long
  1897.   Dim lngData As Long
  1898.   Dim lngDataLen As Long
  1899.   Dim boolDone As Boolean
  1900.   Dim strValueName As String
  1901.   Dim strValue As String
  1902.   Dim strValueEx As String
  1903.   Dim HHRegValues As HH_REG_VALUES
  1904.  
  1905.   On Error GoTo EnumRegValueError
  1906.  
  1907.   ' Reassign the file name so the original
  1908.   ' doesn't become mangled
  1909.   strTempFileName = FileToCheck
  1910.  
  1911.   ' Clear any previous result
  1912.   EnumRegValue.pszFileName = ""
  1913.   EnumRegValue.pszFilePath = ""
  1914.  
  1915.   lngResult = 99
  1916.   lngTopKey = RegKeyID(strTopKey)
  1917.   
  1918.   If lngTopKey = 0 Then GoTo EnumRegValueError
  1919.  
  1920.   lngResult = RegOpenKeyEx(lngTopKey, strSubKey, 0, _
  1921.       KEY_QUERY_VALUE, lngHandle)
  1922.   If lngResult <> ERROR_SUCCESS Then GoTo EnumRegValueError
  1923.     
  1924.   Do While Not boolDone
  1925.         
  1926.     lngDataLen = MAX_SIZE
  1927.     lngValueLen = lngDataLen
  1928.     strValueName = Space$(lngDataLen)
  1929.         
  1930.     lngResult = RegEnumValue(lngHandle, lngIndex, _
  1931.         strValueName, lngValueLen, 0, lngValueType, _
  1932.         ByVal lngData, lngDataLen)
  1933.         
  1934.     If lngResult = ERROR_SUCCESS Then
  1935.     
  1936.       Select Case lngValueType
  1937.       Case REG_SZ, REG_EXPAND_SZ
  1938.         strValue = Space$(lngDataLen)
  1939.         strValueName = Left$(strValueName, lngValueLen)
  1940.         
  1941.         If strValueName = strTempFileName Then
  1942.           HHRegValues.pszFileName = strTempFileName
  1943.           lngResult = RegQueryValueEx(lngHandle, _
  1944.               strValueName, 0, lngValueType, _
  1945.               ByVal strValue, lngDataLen)
  1946.               
  1947.           If lngValueType = REG_EXPAND_SZ Then
  1948.             strValueEx = strValue
  1949.             strValue = String(MAX_SIZE, " ")
  1950.             lngValueLen = ExpandEnvironmentStrings(strValueEx, strValue, MAX_SIZE)
  1951.           End If
  1952.           
  1953.           If lngResult = ERROR_SUCCESS Then
  1954.             strValues = strValues & strValueName & _
  1955.                 "=" & strValue & vbCr
  1956.             HHRegValues.pszFilePath = strValues
  1957.                             
  1958.           Else
  1959.             GoTo EnumRegValueError
  1960.           End If
  1961.           
  1962.           GoTo ExitRoutine
  1963.           
  1964.         End If
  1965.                     
  1966.       Case Else
  1967.       End Select
  1968.       
  1969.       lngIndex = lngIndex + 1
  1970.       
  1971.     Else
  1972.       boolDone = True
  1973.       
  1974.     End If
  1975.   Loop
  1976.  
  1977. ExitRoutine:
  1978.   strValues = strValues & vbCr
  1979.   If Len(strValues) = 1 Then strValues = strValues & vbCr
  1980.     
  1981.   lngResult = RegCloseKey(lngHandle)
  1982.   EnumRegValue = HHRegValues
  1983.     
  1984.   ' Clear any previous arguments
  1985.   strTopKey = ""
  1986.   strSubKey = ""
  1987.   strValues = ""
  1988.   strTempFileName = ""
  1989.     
  1990.   Exit Function
  1991.  
  1992. EnumRegValueError:
  1993.   EnumRegValue = HHRegValues
  1994.   
  1995. End Function
  1996.  
  1997. Public Function GetKeyInfo(ByVal key_name As String, _
  1998.     ByVal indent As Integer) As Boolean
  1999.  
  2000. ' Used with HHInstalled method to verify whether or not
  2001. ' HTML Help is installed on the system.
  2002.  
  2003.   Dim subkeys As Collection
  2004.   Dim subkey_values As Collection
  2005.   Dim subkey_num As Integer
  2006.   Dim subkey_name As String
  2007.   Dim subkey_value As String
  2008.   Dim Length As Long
  2009.   Dim hKey As Long
  2010.   Dim txt As String
  2011.     
  2012.   GetKeyInfo = True
  2013.   
  2014.   Set subkeys = New Collection
  2015.   Set subkey_values = New Collection
  2016.     
  2017.   If RegOpenKeyEx(HKEY_LOCAL_MACHINE, _
  2018.       key_name, _
  2019.       0&, KEY_ALL_ACCESS, hKey) <> ERROR_SUCCESS _
  2020.       Then
  2021.     GetKeyInfo = False
  2022.     Exit Function
  2023.   End If
  2024.     
  2025.   subkey_num = 0
  2026.   Do
  2027.     Length = 256
  2028.     subkey_name = Space$(Length)
  2029.     
  2030.     If RegEnumKey(hKey, subkey_num, _
  2031.         subkey_name, Length) _
  2032.         <> ERROR_SUCCESS Then Exit Do
  2033.         
  2034.     subkey_num = subkey_num + 1
  2035.         
  2036.     subkey_name = Left$(subkey_name, InStr(subkey_name, Chr$(0)) - 1)
  2037.     subkeys.Add subkey_name
  2038.     
  2039.     Length = 256
  2040.     subkey_value = Space$(Length)
  2041.     If RegQueryValue(hKey, subkey_name, _
  2042.         subkey_value, Length) _
  2043.         <> ERROR_SUCCESS _
  2044.         Then
  2045.       subkey_values.Add "Error"
  2046.     Else
  2047.       subkey_value = Left$(subkey_value, Length - 1)
  2048.       subkey_values.Add subkey_value
  2049.       End If
  2050.   Loop
  2051.     
  2052.   If RegCloseKey(hKey) <> ERROR_SUCCESS Then
  2053.     GetKeyInfo = False
  2054.   End If
  2055.     
  2056.   For subkey_num = 1 To subkeys.Count
  2057.     txt = txt & subkeys(subkey_num) & _
  2058.         ": " & subkey_values(subkey_num) & _
  2059.         vbCrLf
  2060.   Next subkey_num
  2061.     
  2062. End Function
  2063.  
  2064. Private Function RegKeyID(ByVal strTopKeyOrFile As String) As Long
  2065.  
  2066. ' Translates the registry key constants
  2067.  
  2068.   Dim strDir As String
  2069.  
  2070.   RegKeyID = 0
  2071.   Select Case UCase$(strTopKeyOrFile)
  2072.   Case "HKCU"
  2073.     RegKeyID = HKEY_CURRENT_USER
  2074.   Case "HKLM"
  2075.     RegKeyID = HKEY_LOCAL_MACHINE
  2076.   Case "HKU"
  2077.     RegKeyID = HKEY_USERS
  2078.   Case "HKDD"
  2079.     RegKeyID = HKEY_DYN_DATA
  2080.   Case "HKCC"
  2081.     RegKeyID = HKEY_CURRENT_CONFIG
  2082.   Case "HKCR"
  2083.     RegKeyID = HKEY_CLASSES_ROOT
  2084.   Case Else
  2085.     On Error Resume Next
  2086.     strDir = Dir$(strTopKeyOrFile)
  2087.     If Err.Number = 0 And strDir <> "" Then RegKeyID = 1
  2088.   End Select
  2089.   Exit Function
  2090.   
  2091. End Function
  2092.  
  2093. Private Function GetLongPath_Legacy(ByVal strShortName As String, _
  2094.     strLongName As String, lngBufferLength As Long) As Long
  2095.  
  2096. ' Translates a short path name into its actual long path
  2097. ' name.  On Windows 98 and 2000 systems and later, uses
  2098. ' the GetLongPathName API call in kernel32.  This is used
  2099. ' on these systems as it renders a slightly faster
  2100. ' processing time. GetLongPath_Legacy is set up in the
  2101. ' following manner to make it compatible with the
  2102. ' GetLongPathName API call:
  2103. '
  2104. ' strShortName:
  2105. '     Pointer to a null-terminated path to be converted.
  2106. ' strLongName:
  2107. '     Pointer to the buffer to receive the long path.
  2108. ' lngBufferLength:
  2109. '     Specifies the size of the buffer, in characters.
  2110.  
  2111. ' If the function succeeds, the return value is the
  2112. ' length of the string copied to the strLongName
  2113. ' parameter, in characters. This length does not include
  2114. ' the terminating null character.
  2115. '
  2116. ' If strLongName is too small on Windows 98 and 2000
  2117. ' systems and later, the function returns the size of the
  2118. ' buffer required to hold the long path, in characters.
  2119. ' This is due to the use of the GetLongPathName API call
  2120. ' on those operating systems.
  2121. '
  2122. ' If the function fails, the return value is zero.
  2123.  
  2124.   On Error GoTo ErrHandler
  2125.   
  2126.   Dim strTempLongName As String
  2127.   Dim strTemp As String
  2128.   Dim strPathTemp As String
  2129.   Dim intLength As Integer
  2130.   Dim intPosition As Integer
  2131.   Dim intStart As Integer
  2132.   Dim lngHandle As Long
  2133.   Dim lpFindFileData As WIN32_FIND_DATA
  2134.   
  2135.   If GetWindowsVersion >= WINDOWS_98 Then
  2136.     ' For Windows 98 and later, and Windows 2000
  2137.     ' and later, use the following API call:
  2138.     GetLongPath_Legacy = GetLongPathName(strShortName, _
  2139.         strLongName, lngBufferLength)
  2140.     Exit Function
  2141.   End If
  2142.   
  2143.   GetLongPath_Legacy = 0
  2144.   
  2145.   ' If stored in the registry, in some cases it's
  2146.   ' enclosed in double-quotes, so we need to delete them
  2147.   If Left$(strShortName, 1) = SINGLE_QUOTE Then _
  2148.       strShortName = Right$(strShortName, Len(strShortName) - 1)
  2149.   If Right$(strShortName, 1) = SINGLE_QUOTE Then _
  2150.       strShortName = Left$(strShortName, Len(strShortName) - 1)
  2151.       
  2152.   ' Add \ to short name to prevent Instr from failing
  2153.   If Right$(strShortName, 1) <> "\" Then _
  2154.       strShortName = Left$(strShortName, Len(strShortName) & "\")
  2155.   
  2156.   ' Save the drive letter for later
  2157.   strLongName = Left(strShortName, 2)
  2158.   
  2159.   ' Strip the drive letter off the temporary string
  2160.   strPathTemp = Right(strShortName, Len(strShortName) - 3)
  2161.   
  2162.   ' Find the first backslash
  2163.   intPosition = InStr(strPathTemp, "\")
  2164.   
  2165.   Do While intPosition <> 0
  2166.     
  2167.     ' Get the individual component of the path name
  2168.     strTemp = Left(strPathTemp, intPosition - 1)
  2169.     
  2170.     ' Translate the short path component into its
  2171.     ' actual long path component as found by FindFirstFile
  2172.     lngHandle = FindFirstFile(strLongName & "\" & strTemp, lpFindFileData)
  2173.     
  2174.     If (lngHandle) = INVALID_HANDLE_VALUE Then
  2175.     
  2176.       ' The folder or file does not exist
  2177.       Exit Function
  2178.     
  2179.     End If
  2180.     
  2181.     ' Get rid of any null characters retrieved if
  2182.     ' from the registry
  2183.     strTempLongName = StripNulls(lpFindFileData.cFileName)
  2184.     
  2185.     ' Build the long path name, starting with the
  2186.     ' previously-saved drive letter
  2187.     strLongName = strLongName & "\" & strTempLongName
  2188.     
  2189.     ' Delete the short path component we just used
  2190.     strPathTemp = Right(strPathTemp, Len(strPathTemp) - (Len(strTemp) + 1))
  2191.     
  2192.     ' Find the next backslash
  2193.     intPosition = InStr(strPathTemp, "\")
  2194.     
  2195.   Loop
  2196.   
  2197.   ' Add the remainder, which is the name of the file
  2198.   strLongName = strLongName & "\" & strPathTemp
  2199.   
  2200.   GetLongPath_Legacy = Len(strLongName)
  2201.  
  2202.   Exit Function
  2203.   
  2204. ErrHandler:
  2205.   Select Case Err.Number
  2206.   Case 52
  2207.     strLongName = ""
  2208.     Exit Function
  2209.   Case Else
  2210.     Resume Next
  2211.   End Select
  2212.  
  2213. End Function
  2214.  
  2215. Private Function StripNulls(OriginalStr As String) As String
  2216.  
  2217. ' Strips any trailing nulls from path names retrieved
  2218. ' from the registry. This function is found in the
  2219. ' following Microsoft(r) knowledge base articles:
  2220. ' Q183009 "HOWTO: Enumerate Windows Using the WIN32 API"
  2221. ' Q185476 "HOWTO: Search Directories to Find or List Files"
  2222. ' Q190218 "HOWTO: Retrieve Settings From a Printer Driver"
  2223.  
  2224.   If (InStr(OriginalStr, Chr(0)) > 0) Then
  2225.     OriginalStr = Left(OriginalStr, _
  2226.         InStr(OriginalStr, Chr(0)) - 1)
  2227.   End If
  2228.   
  2229.   StripNulls = OriginalStr
  2230.   
  2231. End Function
  2232.  
  2233. Private Sub GetHHVersion()
  2234.  
  2235. ' Retrieves the version of HTML Help on the system
  2236.   
  2237.   Dim varHHRegValues As HH_REG_VALUES
  2238.   Dim lngResult As Boolean
  2239.   Dim sHHValues As String
  2240.   Dim strTempHHctrlPath As String
  2241.   Dim strHHctrlPath As String
  2242.   
  2243.   ' Get the path of the registered copy of hhctrl.ocx
  2244.   varHHRegValues = EnumRegValue("HKCR", "CLSID\{4662DAB0-D393-11D0-9A56-00C04FB68B66}\InprocServer32", sHHValues, "")
  2245.   
  2246.   ' If hhctrl.ocx isn't registered, go past the next block.
  2247.   If Len(varHHRegValues.pszFilePath) = 0 Then
  2248.     MessageBoxCritical "Hhctrl.ocx is not registered.  " & _
  2249.         "Please install HTML Help."
  2250.     
  2251.   Else
  2252.     strHHctrlPath = Right(varHHRegValues.pszFilePath, (Len(varHHRegValues.pszFilePath) - 1))
  2253.   
  2254.     Dim lpFindFileData As WIN32_FIND_DATA
  2255.     Dim lngHandle As Long
  2256.     
  2257.     strTempHHctrlPath = StripNulls(strHHctrlPath)
  2258.     
  2259.     ' Translate short path name if registered that way
  2260.     lngResult = GetLongPath_Legacy(strTempHHctrlPath, strHHctrlPath, 256)
  2261.         
  2262.     ' Verify the HTML Help control exists according
  2263.     ' to the registry data.
  2264.     lngHandle = FindFirstFile(strHHctrlPath, lpFindFileData)
  2265.         
  2266.     If (lngHandle) = INVALID_HANDLE_VALUE Then
  2267.       MessageBoxCritical "Hhctrl.ocx is not in its registered location.  " & _
  2268.           "Please reinstall HTML Help."
  2269.       Exit Sub
  2270.     
  2271.     End If
  2272.   
  2273.     mvarHHVersion = GetVersionInfo(strHHctrlPath)
  2274.   
  2275.   End If
  2276.  
  2277. End Sub
  2278.  
  2279. Private Sub GetIEVersion()
  2280.  
  2281. ' Retrieves the version of Internet Explorer on the system
  2282.  
  2283.   Dim varIERegValues As HH_REG_VALUES
  2284.   Dim sIEValues As String
  2285.   Dim strShdocvwPath As String
  2286.   Dim lngResult As Boolean
  2287.   Dim strIexploreTempPath As String
  2288.   Dim lngHandle As Long
  2289.   Dim lpFindFileData As WIN32_FIND_DATA
  2290.  
  2291.   ' Get the path of the registered copy of shdocvw.dll
  2292.   varIERegValues = EnumRegValue("HKCR", "CLSID\{0A89A860-D7B1-11CE-8350-444553540000}\InProcServer32", sIEValues, "")
  2293.   
  2294.   ' If shdocvw.dll isn't registered, go past the next block.
  2295.   If Len(varIERegValues.pszFilePath) = 0 Then
  2296.     MessageBoxCritical "Shdocvw.dll is not registered.  " & _
  2297.         "Please install Internet Explorer."
  2298.   Else
  2299.   
  2300.     strShdocvwPath = Right(varIERegValues.pszFilePath, (Len(varIERegValues.pszFilePath) - 1))
  2301.     
  2302.     ' Translate short path name if registered that way
  2303.     lngResult = GetLongPath_Legacy(StripNulls(strShdocvwPath), strShdocvwPath, 256)
  2304.     
  2305.     ' Verify shdocvw.dll exists according
  2306.     ' to the registry data.
  2307.     lngHandle = FindFirstFile(strShdocvwPath, lpFindFileData)
  2308.     
  2309.     If (lngHandle) = INVALID_HANDLE_VALUE Then
  2310.       MessageBoxCritical "Internet Explorer is not in its registered location.  " & _
  2311.           "Please reinstall Internet Explorer."
  2312.       Exit Sub
  2313.     
  2314.     End If
  2315.   
  2316.     mvarIEVersion = GetVersionInfo(strShdocvwPath)
  2317.     
  2318.   End If
  2319.   
  2320. End Sub
  2321.  
  2322. Private Function GetHHFriendlyName() As String
  2323.  
  2324. ' Retrieves the friendly name of HTML Help as installed
  2325.  
  2326.   If mvarHHVersion = "" Then
  2327.     GetHHVersion
  2328.   End If
  2329.   ' Take into account how this module
  2330.   ' returns version numbers
  2331.   Select Case mvarHHVersion
  2332.   Case "4.72.7290.00"
  2333.     mvarHHFriendlyName = "1.0"
  2334.   Case "4.72.7323.00"
  2335.     mvarHHFriendlyName = "1.1"
  2336.   Case "4.72.7325.00"
  2337.     mvarHHFriendlyName = "1.1a"
  2338.   Case "4.72.8164.00"
  2339.     mvarHHFriendlyName = "1.1b"
  2340.   Case "4.73.8252.00"
  2341.     mvarHHFriendlyName = "1.2"
  2342.   Case "4.73.8412.00"
  2343.     mvarHHFriendlyName = "1.21"
  2344.   Case "4.73.8474.00"
  2345.     mvarHHFriendlyName = "1.21a"
  2346.   Case "4.73.8561.00"
  2347.     mvarHHFriendlyName = "1.22"
  2348.   Case "4.74.8566.00"
  2349.     mvarHHFriendlyName = "1.3"
  2350.   Case Else
  2351.     mvarHHFriendlyName = "unknown"
  2352.   End Select
  2353.   
  2354. End Function
  2355.  
  2356. Private Function GetIEFriendlyName() As String
  2357.  
  2358. ' Retrieves the friendly name of Internet Explorer
  2359. ' as installed
  2360.   
  2361.   If mvarIEVersion = "" Then
  2362.     GetIEVersion
  2363.   End If
  2364.   
  2365.   ' Take into account how this module
  2366.   ' returns version numbers
  2367.   Select Case mvarIEVersion
  2368.   Case "4.70.1155.0000"
  2369.     mvarIEFriendlyName = "3.0"
  2370.   Case "4.70.1158.0000"
  2371.     mvarIEFriendlyName = "3.0 OSR2"
  2372.   Case "4.70.1215.0000"
  2373.     mvarIEFriendlyName = "3.02"
  2374.   Case "4.70.1300.0000"
  2375.     mvarIEFriendlyName = "3.02"
  2376.   Case "4.71.1008.3000"
  2377.     mvarIEFriendlyName = "4.0 PP2"
  2378.   Case "4.71.1712.5000"
  2379.     mvarIEFriendlyName = "4.0"
  2380.   Case "4.72.2106.7000"
  2381.     mvarIEFriendlyName = "4.01"
  2382.   Case "4.72.3110.0300"
  2383.     mvarIEFriendlyName = "4.0 SP1"
  2384.   Case "4.72.3612.1707"
  2385.     mvarIEFriendlyName = "4.0 SP2"
  2386.   Case "5.00.0518.5000"
  2387.     mvarIEFriendlyName = "5.0 beta 1"
  2388.   Case "5.00.0910.1308"
  2389.     mvarIEFriendlyName = "5.0 beta 2"
  2390.   Case "5.00.2014.2130"
  2391.     mvarIEFriendlyName = "5.0"
  2392.   Case "5.00.2314.1000"
  2393.     mvarIEFriendlyName = "5.0a (Office 2000)"
  2394.   Case "5.00.2614.3500"
  2395.     mvarIEFriendlyName = "5.0b (Windows 98 SE)"
  2396.   Case "5.00.2717.2000"
  2397.     mvarIEFriendlyName = "5.0c (Icon Security Issue Update)"
  2398.   Case Else
  2399.     mvarIEFriendlyName = "unknown"
  2400.   End Select
  2401.   
  2402. End Function
  2403.  
  2404. Public Function GetWindowsVersion() As Long
  2405.             
  2406.   Dim osinfo As OSVERSIONINFO
  2407.   Dim retvalue As Integer
  2408.  
  2409.   osinfo.dwOSVersionInfoSize = 148
  2410.   osinfo.szCSDVersion = Space$(128)
  2411.   retvalue = GetVersionExA(osinfo)
  2412.  
  2413.   With osinfo
  2414.     Select Case .dwPlatformId
  2415.     Case VER_PLATFORM_WIN32_WINDOWS
  2416.       If .dwMinorVersion = 0 Then
  2417.         GetWindowsVersion = WINDOWS_95
  2418.       ElseIf .dwMinorVersion = 10 Then
  2419.         GetWindowsVersion = WINDOWS_98
  2420.       End If
  2421.     Case VER_PLATFORM_WIN32_NT
  2422.       If .dwMajorVersion = 3 Then
  2423.         GetWindowsVersion = WINDOWS_NT_3_51
  2424.       ElseIf .dwMajorVersion = 4 Then
  2425.         GetWindowsVersion = WINDOWS_NT_4
  2426.       ElseIf .dwMajorVersion = 5 Then
  2427.         GetWindowsVersion = WINDOWS_2000
  2428.       End If
  2429.     Case Else
  2430.       GetWindowsVersion = UNKNOWN_OS
  2431.     End Select
  2432.   End With
  2433.  
  2434. End Function
  2435.  
  2436. Private Function MessageBoxCritical(ByVal strMessage As String) As Long
  2437.  
  2438. ' Displays a message box with a "critical" icon
  2439.  
  2440.   Dim mbpParams As MSGBOXPARAMS
  2441.  
  2442.   mbpParams.cbSize = Len(mbpParams)
  2443.   mbpParams.dwStyle = MB_OK Or MB_ICONSTOP
  2444.   mbpParams.lpszCaption = "HTML Help Class"
  2445.   mbpParams.lpszText = strMessage
  2446.     
  2447.   MessageBoxCritical = MessageBoxIndirect(mbpParams)
  2448.   
  2449. End Function
  2450.  
  2451. Private Function MessageBoxExclamation(ByVal strMessage As String) As Long
  2452.  
  2453. ' Displays a message box with an "exclamation" icon
  2454.  
  2455.   Dim mbpParams As MSGBOXPARAMS
  2456.  
  2457.   mbpParams.cbSize = Len(mbpParams)
  2458.   mbpParams.dwStyle = MB_OK Or MB_ICONSTOP
  2459.   mbpParams.lpszCaption = "HTML Help Class"
  2460.   mbpParams.lpszText = strMessage
  2461.     
  2462.   MessageBoxExclamation = MessageBoxIndirect(mbpParams)
  2463.   
  2464. End Function
  2465.  
  2466. Private Function MessageBoxInformation(ByVal strMessage As String) As Long
  2467.  
  2468. ' Displays a message box with an "information" icon
  2469.  
  2470.   Dim mbpParams As MSGBOXPARAMS
  2471.  
  2472.   mbpParams.cbSize = Len(mbpParams)
  2473.   mbpParams.dwStyle = MB_OK Or MB_ICONINFORMATION
  2474.   mbpParams.lpszCaption = "HTML Help Class"
  2475.   mbpParams.lpszText = strMessage
  2476.     
  2477.   MessageBoxInformation = MessageBoxIndirect(mbpParams)
  2478.   
  2479. End Function
  2480.  
  2481. Public Property Let HHWindow(ByVal vData As String)
  2482.  
  2483. ' Specifies the HTML Help window for use
  2484. ' with various methods.
  2485.  
  2486.   On Error Resume Next
  2487.     
  2488.   mvarHHWindow = vData
  2489.     
  2490. End Property
  2491.  
  2492. Public Property Get HHWindow() As String
  2493.  
  2494.   On Error Resume Next
  2495.     
  2496.   HHWindow = mvarHHWindow
  2497.     
  2498. End Property
  2499.  
  2500. Public Property Let HHTopicURL(ByVal vData As String)
  2501.  
  2502. ' Specifies the topic path and file name for the
  2503. ' HHDisplayTopicURL method
  2504.  
  2505.   mvarHHTopicURL = vData
  2506.     
  2507. End Property
  2508.  
  2509. Public Property Get HHTopicURL() As String
  2510.  
  2511.   On Error Resume Next
  2512.    
  2513.   HHTopicURL = mvarHHTopicURL
  2514.     
  2515. End Property
  2516.  
  2517. Public Property Let HHTopicID(ByVal vData As Long)
  2518.  
  2519. ' Specifies the context integer for the
  2520. ' HHDisplayTopicID method
  2521.  
  2522.   On Error Resume Next
  2523.     
  2524.   mvarHHTopicID = vData
  2525.     
  2526. End Property
  2527.  
  2528. Public Property Get HHTopicID() As Long
  2529.  
  2530.   On Error Resume Next
  2531.         
  2532.   HHTopicID = mvarHHTopicID
  2533.     
  2534. End Property
  2535.  
  2536. Public Property Let HHMsgTitle(ByVal vData As String)
  2537.  
  2538. ' Specifies the title to display on a message box if
  2539. ' a keyword cannot be found
  2540.  
  2541.   On Error Resume Next
  2542.     
  2543.   mvarHHMsgTitle = vData
  2544.     
  2545. End Property
  2546.  
  2547. Public Property Get HHMsgTitle() As String
  2548.  
  2549.   On Error Resume Next
  2550.     
  2551.   HHMsgTitle = mvarHHMsgTitle
  2552.     
  2553. End Property
  2554.  
  2555. Public Property Let HHMsgText(ByVal vData As String)
  2556.  
  2557. ' Specifies the text to display in a message box if
  2558. ' a keyword cannot be found
  2559.  
  2560.   On Error Resume Next
  2561.     
  2562.   mvarHHMsgText = vData
  2563.     
  2564. End Property
  2565.  
  2566. Public Property Get HHMsgText() As String
  2567.  
  2568.   On Error Resume Next
  2569.     
  2570.   HHMsgText = mvarHHMsgText
  2571.     
  2572. End Property
  2573.  
  2574. Public Property Let HHKeyword(ByVal vData As String)
  2575.  
  2576. ' Specifies a keyword to search for using HHDisplayKeyword
  2577.  
  2578.   On Error Resume Next
  2579.     
  2580.   mvarHHKeyword = vData
  2581.     
  2582. End Property
  2583.  
  2584. Public Property Get HHKeyword() As String
  2585.  
  2586.   On Error Resume Next
  2587.     
  2588.   HHKeyword = mvarHHKeyword
  2589.     
  2590. End Property
  2591.  
  2592. Public Property Let HHDefaultURL(ByVal vData As String)
  2593.  
  2594. ' Specifies the URL to use if a keyword cannot be found
  2595.  
  2596.   On Error Resume Next
  2597.     
  2598.   mvarHHDefaultURL = vData
  2599.     
  2600. End Property
  2601.  
  2602. Public Property Get HHDefaultURL() As String
  2603.  
  2604.   On Error Resume Next
  2605.     
  2606.   HHDefaultURL = mvarHHDefaultURL
  2607.     
  2608. End Property
  2609.  
  2610. Public Property Let HHALink(ByVal vData As String)
  2611.  
  2612. ' Specifies an ALink keyword to search for using
  2613. ' HHDisplayALink
  2614.  
  2615.   On Error Resume Next
  2616.     
  2617.   mvarHHALink = vData
  2618.     
  2619. End Property
  2620.  
  2621. Public Property Get HHALink() As String
  2622.  
  2623.   On Error Resume Next
  2624.     
  2625.   HHALink = mvarHHALink
  2626.     
  2627. End Property
  2628.  
  2629. Public Property Let CHMFile(ByVal vData As String)
  2630.  
  2631. ' Path and file name of the HTML Help file to display
  2632.  
  2633.   On Error Resume Next
  2634.     
  2635.   mvarCHMFile = vData
  2636.     
  2637. End Property
  2638.  
  2639. Public Property Get CHMFile() As String
  2640.  
  2641.   On Error Resume Next
  2642.     
  2643.   CHMFile = mvarCHMFile
  2644.     
  2645. End Property
  2646.  
  2647. Public Property Let HHShowOnTop(ByVal vData As Boolean)
  2648.  
  2649. ' If set to True, the HTML Help window will be set as
  2650. ' a sibling of the calling window
  2651.  
  2652.   On Error Resume Next
  2653.     
  2654.   mvarHHShowOnTop = vData
  2655.     
  2656. End Property
  2657.  
  2658. Public Property Get HHShowOnTop() As Boolean
  2659.  
  2660.   On Error Resume Next
  2661.     
  2662.   HHShowOnTop = mvarHHShowOnTop
  2663.     
  2664. End Property
  2665.  
  2666. Public Property Get HHRegFileName() As String
  2667.  
  2668. ' Used in conjunction with HHCheckRegistry,
  2669. ' returns the confirmed CHM file name
  2670.  
  2671.   On Error Resume Next
  2672.     
  2673.   HHRegFileName = mvarHHRegFileName
  2674.     
  2675. End Property
  2676.  
  2677. Public Property Get HHRegFilePath() As String
  2678.  
  2679. ' Used in conjunction with HHCheckRegistry,
  2680. ' returns the path of the confirmed CHM file name
  2681.  
  2682.   On Error Resume Next
  2683.     
  2684.   HHRegFilePath = mvarHHRegFilePath
  2685.     
  2686. End Property
  2687.  
  2688. Public Property Get HHRegFileExists() As Boolean
  2689.  
  2690. ' Used in conjunction with HHCheckRegistry, returns
  2691. ' True if the file exists at the registered path,
  2692. ' False if it doesn't
  2693.  
  2694.   On Error Resume Next
  2695.     
  2696.   HHRegFileExists = mvarHHRegFileExists
  2697.     
  2698. End Property
  2699.  
  2700. Public Property Let HHPopupFile(ByVal vData As String)
  2701.  
  2702. ' Specifies the text file containing the popup text as
  2703. ' listed in the [TEXT POPUPS] section of a CHM
  2704.  
  2705.   On Error Resume Next
  2706.     
  2707.   mvarHHPopupFile = vData
  2708.     
  2709. End Property
  2710.  
  2711. Public Property Let HHPopupID(ByVal vData As Long)
  2712.  
  2713. ' Specifies the resource containing the to retrieve
  2714. ' popup text from as listed in a Visual Basic project
  2715. ' or the context integer of a popup topic as specified
  2716. ' in a valid popup file in a CHM
  2717.  
  2718.   On Error Resume Next
  2719.     
  2720.   mvarHHPopupID = vData
  2721.     
  2722. End Property
  2723.  
  2724. Public Property Let HHPopupText(ByVal vData As String)
  2725.  
  2726. ' Specifies the text to display in a simple text popup
  2727.  
  2728.   On Error Resume Next
  2729.     
  2730.   mvarHHPopupText = vData
  2731.     
  2732. End Property
  2733.  
  2734. Public Property Let HHPopupType(ByVal vData As PopupType)
  2735.  
  2736. ' The type of popup to be generated by HHDisplayPopup
  2737.  
  2738.   On Error Resume Next
  2739.     
  2740.   mvarHHPopupType = vData
  2741.     
  2742. End Property
  2743.  
  2744. Public Property Let HHPopupTextColor(ByVal vData As ColorConstants)
  2745.  
  2746. ' Sets the text color for a popup generated with HHDisplayPopup using
  2747. ' the standard VB color constants
  2748.  
  2749.   On Error Resume Next
  2750.     
  2751.   mvarHHPopupTextColor = vData
  2752.     
  2753. End Property
  2754.  
  2755. Public Property Let HHPopupBackColor(ByVal vData As ColorConstants)
  2756.  
  2757. ' Sets the back color of a popup generated with HHDisplayPopup using
  2758. ' the standard VB color constants
  2759.  
  2760.   On Error Resume Next
  2761.     
  2762.   mvarHHPopupBackColor = vData
  2763.     
  2764. End Property
  2765.  
  2766. Public Property Let HHPopupCustomTextColor(ByVal vData As Long)
  2767.  
  2768. ' Sets the text color for a popup generated with
  2769. ' HHDisplayPopup using custom colors in the form &HBBGGRR.
  2770.  
  2771.   On Error Resume Next
  2772.     
  2773.   mvarHHPopupCustomTextColor = vData
  2774.     
  2775. End Property
  2776.  
  2777. Public Property Let HHPopupCustomBackColor(ByVal vData As Long)
  2778.  
  2779. ' Sets the back color of a popup generated with
  2780. ' HHDisplayPopup using custom colors in the form &HBBGGRR
  2781.  
  2782.   On Error Resume Next
  2783.     
  2784.   mvarHHPopupCustomBackColor = vData
  2785.     
  2786. End Property
  2787.  
  2788. Public Property Let HHPopupCustomColors(ByVal vData As Boolean)
  2789.  
  2790. ' True of the HHPopupCustomTextColor and HHPopupCustomBackColor
  2791. ' are going to be used, False if not
  2792.  
  2793.   On Error Resume Next
  2794.     
  2795.   mvarHHPopupCustomColors = vData
  2796.     
  2797. End Property
  2798.  
  2799. Public Property Get HHPopupCustomColors() As Boolean
  2800.  
  2801.   On Error Resume Next
  2802.         
  2803.   HHPopupCustomColors = mvarHHPopupCustomColors
  2804.     
  2805. End Property
  2806.  
  2807. Public Property Let HHPopupTextFont(ByVal vData As String)
  2808.  
  2809. ' Name of the font to be used in a text popup
  2810.  
  2811.   On Error Resume Next
  2812.     
  2813.   mvarHHPopupTextFont = vData
  2814.     
  2815. End Property
  2816.  
  2817. Public Property Let HHPopupTextSize(ByVal vData As String)
  2818.  
  2819. ' Point size of the font used in a text popup
  2820.  
  2821.   On Error Resume Next
  2822.     
  2823.   mvarHHPopupTextSize = vData
  2824.     
  2825. End Property
  2826.  
  2827. Public Property Let HHPopupTextBold(ByVal vData As Boolean)
  2828.  
  2829. ' Set to True to make the popup text bold, False otherwise
  2830.  
  2831.   On Error Resume Next
  2832.     
  2833.   mvarHHPopupTextBold = vData
  2834.     
  2835. End Property
  2836.  
  2837. Public Property Let HHPopupTextItalic(ByVal vData As Boolean)
  2838.  
  2839. ' Set to True to make the popup text italicized, False otherwise
  2840.  
  2841.   On Error Resume Next
  2842.     
  2843.   mvarHHPopupTextItalic = vData
  2844.     
  2845. End Property
  2846.  
  2847. Public Property Let HHPopupTextUnderline(ByVal vData As Boolean)
  2848.  
  2849. ' Set to True to make the popup text underlined, False otherwise
  2850.  
  2851.   On Error Resume Next
  2852.     
  2853.   mvarHHPopupTextUnderline = vData
  2854.     
  2855. End Property
  2856.  
  2857. Public Property Get HHInstalled() As Boolean
  2858.    
  2859. ' Verifies whether or not HTML Help is installed on
  2860. ' the system.  This is done by checking the existence of
  2861. ' HKEY_LOCAL_MACHINE\Software\CLASSES\TypeLib\{ADB880A2-D8FF-11CF-9377-00AA003B7A11}
  2862.    
  2863.   mvarHHInstalled = GetKeyInfo("SOFTWARE\Classes\TypeLib\{ADB880A2-D8FF-11CF-9377-00AA003B7A11}", 0)
  2864.    
  2865.   HHInstalled = mvarHHInstalled
  2866.     
  2867. End Property
  2868.  
  2869. Public Property Get HHVersion() As String
  2870.  
  2871. ' Returns the current version of HTML Help on the
  2872. ' system as a String expression
  2873.  
  2874.   On Error Resume Next
  2875.     
  2876.   GetHHVersion
  2877.         
  2878.   HHVersion = mvarHHVersion
  2879.     
  2880. End Property
  2881.  
  2882. Public Property Get IEVersion() As String
  2883.  
  2884. ' Returns the current version of Internet Explorer on
  2885. ' the system as a String expression
  2886.  
  2887.   On Error Resume Next
  2888.     
  2889.   GetIEVersion
  2890.         
  2891.   IEVersion = mvarIEVersion
  2892.     
  2893. End Property
  2894.  
  2895. Public Property Get HHFriendlyName() As String
  2896.  
  2897. ' Returns the friendly name of the HTML Help version
  2898. ' as a String expression (i.e, "1.21a")
  2899.  
  2900.   On Error Resume Next
  2901.     
  2902.   GetHHFriendlyName
  2903.         
  2904.   HHFriendlyName = mvarHHFriendlyName
  2905.     
  2906. End Property
  2907.  
  2908. Public Property Get IEFriendlyName() As String
  2909.  
  2910. ' Returns the friendly name of the Internet Explorer
  2911. ' version as a String expression (i.e, "5.0")
  2912.  
  2913.   On Error Resume Next
  2914.     
  2915.   GetIEFriendlyName
  2916.         
  2917.   IEFriendlyName = mvarIEFriendlyName
  2918.     
  2919. End Property
  2920.